X-Git-Url: http://git.osdn.net/view?p=rec10%2Frec10-git.git;a=blobdiff_plain;f=rectool%2Ftrunk%2Frectool.pl;h=7a9491dd40d289a7726007020b398b582634e728;hp=3966622cca418a2f531f82770b9e0f5488655ca1;hb=d4e8f5397a0f4731f8307dd35bed92c4ada59934;hpb=a74471aea30646a6e6c5d8ed5091e0ece94608ec diff --git a/rectool/trunk/rectool.pl b/rectool/trunk/rectool.pl index 3966622..7a9491d 100755 --- a/rectool/trunk/rectool.pl +++ b/rectool/trunk/rectool.pl @@ -8,32 +8,52 @@ #Date_Init("TZ=JST","ConvTZ=JST"); #use SVG; #use KCatch; -use CGI::Carp qw( fatalsToBrowser ); -use DBI; +use warnings; +use Algorithm::Diff qw(LCS); +use Archive::Zip; +use CGI; +use CGI::Carp qw( fatalsToBrowser warningsToBrowser ); +use Config::Simple; +use Data::Dumper; use Date::Simple; use DateTime; -use CGI::Minimal; +use DBI; use MIME::Base64; -use Config::Simple; +use Perl6::Slurp; +use Sort::Naturally; +use Time::Piece; +use Time::Seconds; 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 ); +use Tie::IxHash; +#require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util +use utf8; +#%DB::packages = ( 'main' => 1 ); + + +################ バージョン定義 ################ + + +my $rectool_version = 101; + + +################ 初期化ここから ################ + + 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 ( -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' ); if ( $sql eq 'MySQL' ) { my $name = $cfg->param( 'db.mysql_dbname' ); @@ -44,14 +64,16 @@ 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' ); - $SQL{'SUBSTR'} = 'SUBSTRING(start, 1, 8)'; } -my $HTML; +my $rec10_version = eval { + $dbh->selectrow_array( "SELECT version FROM in_status " ); +}; -#print "Content-Type: text/html\n\n"; +my $HTML; $HTTP_HEADER = "Content-Type: text/html\n\n"; $HTML .= < Rec10%HTML_TITLE_OPT% + - - + + + %REFRESH% %SCRIPT% %CSS% @@ -71,49 +95,192 @@ $HTML .= <selectrow_array( "SELECT webuser, webpass FROM in_settings " ); +}; + +if ( $user and $pass ) { + if ( $ENV{'HTTP_AUTHORIZATION'} ) { + my ( $base64 ) = $ENV{'HTTP_AUTHORIZATION'} =~ /Basic\s(.*)/; + if ( $base64 eq encode_base64( "$user:$pass" ) ) { + $auth = 1; + } + else { + $auth = 0; + } + } + else { + $auth = 0; + } +} +else { + $auth = 1; +} + +if ( !$auth ) { + my ( $base64 ) = $ENV{'REMOTE_USER'} =~ /Basic (.*)/; + $HTTP_HEADER = qq {Status: 401 Authorization Required\nWWW-Authenticate: Basic realm="Protected Rec10 $ENV{'HTTP_AUTHORIZATION'}"\n} . $HTTP_HEADER; + goto end; +} + +if ( $rec10_version != $rectool_version ) { + $HTML .= qq {
\n}; + + if ( $rec10_version > $rectool_version ) { + $HTML .= qq {Rec10本体のバージョンが新しいため、実行できません。
\n}; + $HTML .= qq {rectoolのバージョンアップを行ってください。
\n}; + } + + if ( $rec10_version < $rectool_version ) { + $HTML .= qq {Rec10本体のバージョンが古いため、実行できません。
\n}; + $HTML .= qq {Rec10のバージョンアップを行ってください。
\n}; + } + + $HTML .= qq {Rec10のバージョンは$rec10_version 、rectoolのバージョンは$rectool_version です。
\n}; + $HTML .= qq {公式ページ\n}; + goto end; +} + +$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|19)[1-3])/, @{$ary_ref}; +my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!(10|19)[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; + -$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' ); +tie %type, 'Tie::IxHash'; %type = ( - 'res' => '一回限定', - 'rec' => '最終段階', - 'key' => '当日検索', - 'keyevery' => '隔日検索', - 'tsrecording' => '録画途中', - 'tsfin' => '録画終了', - 'tsmiss' => '録画失敗', - 'b252ts' => '解読予約', - 'tsdecoding' => '解読途中', - 'ts2avi' => '縁故予約', - 'local' => '縁故於鯖', - 'grid' => '縁故於網', - 'fin_local' => '縁故完了', - 'end' => '録画終了', + 'search_everyday' => '隔日検索', + 'search_today' => '当日検索', + 'reserve_flexible' => '浮動予約', + 'reserve_fixed' => '確定予約', + + 'reserve_running' => '録画途中', + + 'convert_b25_ts' => '解読予約', + 'convert_b25_ts_running' => '解読途中', + 'convert_b25_ts_miss' => '解読失敗', + + 'convert_ts_mp4' => '縁故予約', + 'convert_ts_mp4_running' => '縁故於鯖', + 'convert_ts_mp4_network' => '縁故於網', + 'convert_ts_mp4_finished' => '縁故完了', + + 'convert_avi_mkv' => '変換旧露', + 'convert_avi_mp4' => '変換旧四', + 'convert_mkv_mp4' => '変換露四', + 'convert_mkv_mp4_runnings' => '換途露四', + + 'auto_suggest_dec' => '予測解読', + 'auto_suggest_enc' => '予測縁故', + 'auto_suggest_avi2fp' => '予測旧四', + 'auto_suggest_ap2fp' => '予測露四', + + 'move_end' => '移動完了', +); + +%type_suggest = ( + 'auto_suggest_dec' => 'convert_b25_ts', + 'auto_suggest_enc' => 'convert_ts_mp4', + 'auto_suggest_avi2fp' => 'convert_avi_mkv', + 'auto_suggest_ap2fp' => 'convert_mp4_mkv', +); + +%color = ( + 'search_everyday' => '#8B008B', + 'search_today' => '#8B008B', + 'reserve_flexible' => '#4169E1', + 'reserve_fixed' => '#4169E1', + 'reserve_running' => '#FF8C00', + 'convert_b25_ts' => '#CD5C5C', + 'convert_b25_ts_running' => '#DC143C', + 'convert_ts_mp4' => '#32CD32', + 'convert_ts_mp4_running' => '#2E8B57', + 'convert_ts_mp4_network' => '#808000', + + 'other' => '#A0A0A0', ); +$type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )"; + +tie %category, 'Tie::IxHash'; %category = ( - 'etc' => 'その他', - 'news' => 'ニュース・報道', - 'variety' => 'バラエティ', - 'anime' => 'アニメ・特撮', - 'information' => '情報', - 'drama' => 'ドラマ', - 'sports' => 'スポーツ', - 'music' => '音楽', - 'cinema' => '映画', + 'news' => { name => 'ニュース・報道' , color => '#ff0000' }, + 'sports' => { name => 'スポーツ' , color => '#ff8000' }, + 'information' => { name => '情報' , color => '#ffff00' }, + 'drama' => { name => 'ドラマ' , color => '#80ff00' }, + 'music' => { name => '音楽' , color => '#00ff00' }, + 'variety' => { name => 'バラエティ' , color => '#00ff80' }, + 'cinema' => { name => '映画' , color => '#00ffff' }, + 'anime' => { name => 'アニメ・特撮' , color => '#0080ff' }, + 'documentary' => { name => 'ドキュメンタリー・教養' , color => '#0000ff' }, + 'stage' => { name => '演劇' , color => '#8000ff' }, + 'hobby' => { name => '趣味・実用' , color => '#ff00ff' }, + 'etc' => { name => 'その他' , color => '#ff0080' }, ); +################ 初期化ここまで ################ + + +################ mode=schedule ################ + if ( $mode eq 'schedule' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/; -# $HTML =~ s|%REFRESH%||; + #$HTML =~ s|%REFRESH%||; $css = < td { @@ -124,8 +291,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'; } @@ -133,19 +300,14 @@ EOM $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 {
\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"); - + "SELECT id, type, timeline.chtxt, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime, + epgtitle, epgbtime, epgetime, epgexp, epgduplicate, epgchange, counter + FROM timeline + LEFT OUTER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt + ORDER BY $order" + , {Slice=>{}}); + + $HTML .= qq {
\n}; $HTML .= qq {
\n}; $HTML .= qq {
\n}; $HTML .= qq {\n}; @@ -161,152 +323,148 @@ EOM $HTML .= qq {オプション\n}; $HTML .= qq {dd\n}; $HTML .= qq {dt\n}; + $HTML .= qq {残り\n}; $HTML .= qq {\n}; foreach my $line ( @{ $ary_ref } ) { - $type = $type{$line->[1]} || $line->[1]; - if ( $line->[1] eq 'key' || $line->[1] eq 'keyevery' ) { - $type = qq {$type}; - $line->[9] = qq {空} if ( !$line->[9] && $line->[1] eq 'keyevery' ); - $line->[10] = qq {空} if ( !$line->[10] ); - } - elsif ( $line->[1] eq 'res' || $line->[1] eq 'rec' ) { - $type = qq {$type}; - } - elsif ( $line->[1] eq 'tsrecording' ) { - $type = qq {$type}; + $type = $type{$line->{type}} || $line->{type}; + if ( $line->{type} =~ /^search/ ) { + $type = qq {$type}; + $line->{deltaday} = qq {空} if ( !$line->{deltaday} && $line->{type} eq 'search_everyday' ); + $line->{deltatime} = qq {空} if ( !$line->{deltatime} ); } - elsif ( $line->[1] eq 'b252ts' || $line->[1] eq 'ts2avi' ) { - $type = qq {$type}; - } - elsif ( $line->[1] eq 'tsdecoding' ) { - $type = qq {$type}; + else { + my $color = $color{$line->{type}} ? $color{$line->{type}} : $color{'other'}; + $type = qq {$type}; } - elsif ( $line->[1] eq 'local' ) { - $type = qq {$type}; + # 地上波の場合、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 { - $type = qq {$type}; + $line->{chname_link} = qq {$line->{chname}}; } - $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 {$ary[0]}; + $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; } - } - if ( $ary[1] ) { - $line->[11] = qq {
$ary[0]
}; } else { - # $line->[11] = qq {該当なし}; - $line->[11] = qq {説明なし}; + # epgtitleとtitleが一致している + $epgtitle = '説明'; } + + $line->{title_2} = qq {
$epgtitle
}; } else { - my $href = qq {自動検索}; - $line->[11] = qq {！$href！}; + # epgtitleがない + my $href = qq {自動検索}; + $line->{title_2} = qq {■$href■}; + $line->{tr_style} = qq {style="background-color: #A0A0A0"}; } } - 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 ( $begin, $end, $diff ) = &str2readable( $unix_b, $unix_e ); - 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; + my $hr = ''; if ( - $line->[1] eq 'tsrecording' + $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]
} if ( $line->[11] ); - $line->[5] = qq {$line->[5]}; - $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->[11]\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}; - # $HTML .= qq {$line->[11]\n} if ( $extra ); + $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' ) { - $graph = $q->param( 'graph' ); + my $date = $params{ 'date' }; - if ( $graph ) + if ( $date ) { 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' ); + $date = Date::Simple->new( split /-/, $date ); + $graph_bgn = $date->format('%Y-%m-%d'); + $graph_end = $date->next->format('%Y-%m-%d'); + $day = $date->day; + $today = $date eq Date::Simple->today() ? 1 : 0; + + $tuner{terrestrial} = $cfg->param( 'env.te_max' );# 2; + $tuner{satellite} = $cfg->param( 'env.bscs_max' );# 2; $tuner{all} = $tuner{terrestrial} + $tuner{satellite}; $hours = 24; $width = 30 * $hours; + my %category_color = map { $_->{name}, $_->{color} } values %category; $svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 ); $svg->rectangle( 'x' => 40, 'y' => 20, @@ -325,12 +483,15 @@ if ( $mode eq 'graph' ) { $svg->text( 'x' => $_ * 30 + 65, 'y' => 15, style => { 'text-anchor' => 'middle' } ) ->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours ); -# $svg->line( ); # can't use when required + # $svg->line( ); # can't be used 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 ); +# $svg->tag( 'line', x1 =>50, x2 => 50 + $width, y1 => $_ * 20 + 10, y2 => $_ * 20 + 10, +# style => { stroke => 'gray' } ); +# $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 ); + $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 14, width => $width, height => 2 ); } if ( $today ) { require Time::Simple; @@ -339,59 +500,48 @@ if ( $mode eq 'graph' ) { $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})/; + my $ary_ref = $dbh->selectall_arrayref( + # epg_timeline.channel = timeline.chtxt && + "SELECT id, title, chtxt, btime, etime, epgcategory, opt FROM timeline + WHERE type IN $type_user_made + 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 btime" + , {Slice=>{}} + ); + + foreach my $bctype ( '\d+_', 'S_' ) { + my $tuner = $bctype eq '\d+_' ? $tuner{terrestrial} : $tuner{satellite}; + my @ary_ref = grep { $_->{chtxt} =~ /$bctype/ } @{ $ary_ref }; + my @y_drawn = ('') x $tuner; + foreach my $line ( @ary_ref ) { + @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]; - - 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; - } + $begin = $line->{btime}; + $end = $line->{etime}; + + my @ary = grep { ( $_->{etime} cmp $line->{btime} ) > 0 and ( $_->{btime} cmp $line->{etime} ) < 0 and $_->{id} != $line->{id} } @ary_ref; + foreach my $i ( 0..$tuner - 1 ) { + next if ( ( $y_drawn[$i] cmp $line->{btime} ) > 0 ); + #for ( 'chtxt', 'btime', 'etime' ) { + # $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} ); + #} + $line->{slot} = $i; + $y_drawn[$i] = $line->{etime}; + last; } 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; @@ -402,61 +552,69 @@ if ( $mode eq 'graph' ) { } my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' ); sub html_escape{ - my $str = shift or return; - my $result = ''; - $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_ - for (split //, $str); - $result; + my $str = shift or return; + my $result = ''; + $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_ + for (split //, $str); + $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, + 'y' => 30 + ( $bctype eq '\d+_' ? 0 : $tuner{terrestrial} * 20 ) + $line->{slot} * 20, width => $stop - $start, height => 10, - style => { fill => "rgb($r,$g,$b)" } ); + style => { fill => $category_color{$line->{epgcategory}} || $category_color{'その他'} } ); + #style => { fill => "rgb($r,$g,$b)" } ); } } - print $svg->xmlify; + my $xml = $svg->xmlify; + utf8::encode( $xml ); + print $xml; + #warningsToBrowser(true); exit; } else { $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/; $HTML .= qq {
\n}; -# $base64 = encode_base64( $svg->xmlify ); -# $HTML .= qq {\n\n}; - $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CS、赤はアニメ、緑はHD、青は2 passを示しています。
\n}; + # $base64 = encode_base64( $svg->xmlify ); + # $HTML .= qq {\n\n}; + $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CSを示しています。
\n}; $HTML .= qq {SVGが利用可能なブラウザでご覧ください。
\n}; + $HTML .= qq {色とジャンルの対応\n}; + map { + $HTML .= qq {$_->{name}\n}; + } values %category; + $HTML .= qq {
\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' ) + FROM timeline + WHERE type in $type_user_made 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 ); + #utf8::encode( $dn ); $HTML .= qq {$date[1]/$date[2]($dn)の予約状況
\n}; - $HTML .= qq {\n}; - # width=821 height=121>\n}; + # + $HTML .= qq {\n}; $HTML .= qq {SVG Image $date\n\n
\n}; $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d'); my $ary_ref = $dbh->selectall_arrayref( - "SELECT chtxt, title, btime, etime FROM rectime + "SELECT chtxt, title, btime, etime FROM timeline 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]
\n}; + #$HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]
\n}; } } @@ -465,7 +623,83 @@ if ( $mode eq 'graph' ) { } } +################ mode=atom ################ + +if ( $mode eq 'atom' ) { + require XML::Atom::Feed; + require XML::Atom::Entry; + + my $recording_count = $encoding_count = $jbk_count = 0; + my $ary_ref = $dbh->selectall_arrayref( + "SELECT chtxt, title, btime, etime, opt + FROM timeline + WHERE type = 'reserve_running' "); + foreach my $line ( @{$ary_ref} ) { + my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] ); + $recording_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]
\n}; + $recording_count++; + } + $ary_ref = $dbh->selectall_arrayref( + "SELECT chtxt, title, btime, etime, opt + FROM timeline + WHERE type = 'convert_ts_mp4_running' "); + foreach my $line ( @{$ary_ref} ) { + my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] ); + $encoding_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]
\n}; + $encoding_count++; + } + $ary_ref = $dbh->selectall_arrayref( + "SELECT id, chtxt, title, btime, etime + FROM auto_timeline_keyword " ); + foreach my $line ( @{$ary_ref} ) { + my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] ); + $jbk_status .= qq {$line->[0] $line->[1] $line->[2] $begin - $end $diff
\n}; + $jbk_count++; + } + + my $feed = XML::Atom::Feed->new( Version => 1.0 ); + $feed->title('Rec10 フィード'); + + my $entry = XML::Atom::Entry->new( Version => 1.0 ); + $entry->title("Rec10 録画状況 ($recording_count)"); + $entry->id('tag:recording_status'); + $entry->content($recording_status); + $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) ); + $feed->add_entry($entry); + + $entry = XML::Atom::Entry->new( Version => 1.0 ); + $entry->title("Rec10 縁故状況 ($encoding_count)"); + $entry->id('tag:encoding_status'); + $entry->content($encoding_status); + $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) ); + $feed->add_entry($entry); + + $entry = XML::Atom::Entry->new( Version => 1.0 ); + $entry->title("Rec10 地引状況 ($jbk_count)"); + $entry->id('tag:jbk_status'); + $entry->content($jbk_status); + $entry->add_link(str_to_link( './rectool.pl?mode=jbk' ) ); + $feed->add_entry($entry); + + my $xml = $feed->as_xml; + print "Content-Type: application/atom+xml\n\n"; + print $xml; + exit; + + sub str_to_link { + my $link = XML::Atom::Link->new( Version => 1.0 ); + $link->type('text/html'); + $link->rel('alternate'); + $link->href(shift); + return $link; + } +} + +################ mode=edit ################ + if ( $mode eq 'edit' ) { + my $id = $params{ 'id' }; + $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/; $HTML .= qq {
\n}; @@ -476,11 +710,11 @@ if ( $mode eq 'edit' ) { function setType(value){ var index = document.reserve.type.selectedIndex; var value = document.reserve.type[index].value; - if ( value == 'keyevery' ) { + if ( value == 'search_everyday' ) { document.reserve.deltaday.value = 7; document.reserve.deltatime.value = 3; } - if ( value == 'ts2avi' || value == 'b252ts' ){ + if ( value == 'convert_b25_ts' || value == 'convert_ts_mp4' ){ var date = new Date(); var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss"); var minutes = date.getMinutes(); @@ -495,6 +729,12 @@ if ( $mode eq 'edit' ) { document.reserve.begin.value = start; document.reserve.end.value = stop; } + function shiftEndTime(value){ + var dateFormat = new DateFormat("yyyy-MM-dd HH:mm:ss"); + var date = dateFormat.parse(document.reserve.end.value || document.reserve.begin.value); + date.setSeconds( date.getSeconds() + value ); + document.reserve.end.value = dateFormat.format(date); + } EOM $script =~ s/^\t{2}//gm; @@ -502,27 +742,26 @@ EOM $HTML .= "スケジュール編集画面です。
\n"; $HTML .= "実装がとても適当なので、利用には細心の注意を払ってください。
\n
\n"; - if ( $id[0] ) { - @reserve = $dbh->selectrow_array( - "SELECT id, type, chtxt, title, btime, etime, deltaday, deltatime, opt - FROM rectime - WHERE id = $id[0]" - ); + if ( $id ) { + # 予約の編集 + &parse_program(); $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' ); + # 新規予約 + $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' ); $button_bgn = qq{\n
\n}; - $button_end = qq{}; + $button_end = + qq{} + .qq{} + .qq{}; } - 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})/; + 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( year => $btime[0], month => $btime[1], day => $btime[2], hour => $btime[3], minute => $btime[4], second => $btime[5], @@ -531,36 +770,7 @@ EOM 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 ); - } + my %hash = &sqlgetsuggested( $btime, $etime ); $HTML .= qq {可能性のある番組
\n}; $HTML .= qq {\n\n}; @@ -586,15 +796,17 @@ EOM $HTML .= qq {
\n
\n}; } - my $len = length $reserve[0]; + my $len = length $id; $HTML .= qq {
\n}; $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {ID\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {ID\n\n}; $HTML .= qq {タイプ\n\n}; - $HTML .= qq {チャンネル\n\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 {\n}; } else { - $HTML .= qq {\n}; + $HTML .= qq {\n}; } } $HTML .= qq {
\n}; - $HTML .= qq {タイトル\n
\n}; - $HTML .= qq {開始時刻\n\n}.$button_bgn; - $HTML .= qq {終了時刻\n\n}.$button_end."
\n"; - $HTML .= qq {隔日周期\n\n}; - $HTML .= qq {時刻誤差\n\n}; - $HTML .= qq {オプション\n\n}; + $HTML .= qq {タイトル\n
\n}; + $HTML .= qq {開始時刻\n\n}; + $HTML .= $button_bgn; + $HTML .= qq {終了時刻\n\n}; + $HTML .= $button_end . "
\n"; + $HTML .= qq {隔日周期\n\n}; + $HTML .= qq {時刻誤差\n\n}; + $HTML .= qq {オプション\n\n}; + $HTML .= qq {回数\n\n}; $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 ) { - $dbh->do( "DELETE FROM rectime WHERE id = '$id'" ); + $dbh->do( "DELETE FROM timeline WHERE id = '$id'" ); } $HTML .= "削除しました。
\n5秒後に予約確認画面に移動します。
\n"; $HTML =~ s|%REFRESH%||; goto end; } } - if ( $q->param( 'edit' ) ) - { - if ( $q->param( 'edit' ) eq '編集(要JS)' ) { - $HTML .= "スケジュール編集画面に移動します。
\n"; - $HTML =~ s|%REFRESH%||; - goto end; - } - else { - goto end; - } - } - if ( $q->param( 'update' ) ) + if ( $params{ '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' ); + $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[0] ) { + if ( $id ) { $dbh->do( - "UPDATE rectime SET type = '$type', chtxt = '$chtxt', title = '$title', + "UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title', btime = '$begin', etime = '$end', - deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt' + deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt', counter = '$counter' 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' )" + "INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter ) + VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt', '$counter' )" ); } $HTML .= "更新しました。
\n5秒後に予約確認画面に移動します。
\n"; $HTML =~ s|%REFRESH%||; goto end; } -} + if ( $mode_sub eq 'proc' ) { + my $type = $params{ 'type' }; + my $chtxt = $params{ 'chtxt' } || 'nhk-k'; + my $title = $params{ 'title' }; + my @opt = $q->param( 'opt' ); + my $opt = join '', @opt; + + my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10); + my $sql_type = $type_suggest{$type}; + my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' ); + $datetime_now = $datetime_now->add( minutes => 60 ); + my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' ); -if ( $mode eq 'confirm' ) { - # && $display && $start && $stop + $dbh->do( + "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt ) + VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )" + ); - $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/; - $HTML .= qq {
\n}; - &parse_program(); + goto end; + } + if ( $mode_sub eq 'move' ) { + 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 '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`"; + } + elsif ( $mode_sub2 eq 'exec' ) { + eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`"; + } + utf8::decode( $response ); + $HTML .= $response; - my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes; - $HTML .= "番組名：$title
\nチャンネル：$display
\n放送継続時間：$duration分
\n"; - if ( &check_error() ) - { - # エラー + goto end; + } + if ( $mode_sub eq 'setting' ) { + 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' } || ''; - $ary_ref = $dbh->selectall_arrayref( - "SELECT start, stop FROM tv WHERE channel = '$channel' AND title = '$title' " + $dbh->do( + "UPDATE in_settings SET auto_jbk = '$jbk', auto_bayes = '$bayes', + auto_del_tmp = '$del_tmp', auto_opt = '$opt'" ); - $HTML .= "同一の番組の他の放送予定です。
\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 {可能}; - $HTML .= "開始：$begin\n終了：$end\n録画は$overlap
\n"; - } + + goto end; } - else { - $desc = $dbh->selectrow_array( - "SELECT exp FROM tv WHERE channel = '$channel' AND start = '$start' AND stop = '$stop' " + if ( $mode_sub eq 'fixstatus' ) { + my $key = $params{ 'terec' } ? 'terec' : $params{ 'bscsrec' } ? 'bscsrec' : + $params{ 'b252ts' } ? 'b252ts' : $params{ 'ts2avi' } ? 'ts2avi' : ''; + + $dbh->do( + "UPDATE in_status SET $key = 0" ); - $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
\n
\n録画予約の詳細設定を行ってください。
\n"; + goto end; + } + +} + +################ mode=confirm ################ + +if ( $mode eq 'confirm' ) { + if ( $mode_sub eq 'reserve' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/; + $HTML .= qq {
\n}; + &parse_program(); + + my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes; + $HTML .= "番組名：$title
\nチャンネル：$chname
\n放送継続時間：$duration 分
\n番組内容：$desc
\nジャンル：$category
\n"; + if ( $longdesc ) { + $longdesc =~ s/\\n/
\n/gs; + $HTML .= "番組内容(長)：$longdesc
\n"; + } + my $error = &check_error(); + if ( $error ) + { + # エラー + + $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop FROM epg_timeline WHERE channel = '$chtxt' AND title = '$title' " + ); + if ( $error != 1 ) { + $HTML .= "同一の番組の他の放送予定です。
\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 {可能}; + $HTML .= "開始：$begin\n終了：$end\n録画は$overlap
\n"; + } + } + } + else { + $HTML .= "録画予約の詳細設定を行ってください。
\n"; + $HTML .= qq {
\n}; + $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}; + } + goto end; + } + # End of $mode_sub eq 'reserve'; + + if ( $mode_sub eq 'proc' ) { + 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"; + $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 {2passモード\n}; - $HTML .= qq {5.1ch放送\n}; - $HTML .= qq {Xvidモード\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + &draw_form_channel( 'nonone' ); + &draw_form_opt(); $HTML .= qq {\n
\n}; + goto end; } - goto end; } +################ mode=reserve ################ + if ( $mode eq 'reserve' ) { $HTML .= qq {
\n}; &parse_program(); + $title = $params{ 'title' } if ( !$title ); @opt = $q->param( 'opt' ); $opt = join '', @opt; + my ( $deltaday, $deltatime ); + + if ( $params{'every'} eq '1' ) { + $type = 'search_everyday'; + ( $changed_t ) = $title =~ /(.*)#/; + $title = $changed_t if ( $changed_t ); + ( $changed_t ) = $title =~ /(.*)第/; + $title = $changed_t if ( $changed_t ); + ( $changed_t ) = $title =~ /(.*)▽/; + $title = $changed_t if ( $changed_t ); + $title =~ s/「.*」//; + $title =~ s/＜.*＞//; + $title =~ s/（.*）//; + $title =~ s/\[新\]//; + $title =~ s/無料≫//; + $title =~ s/\s*$//; + $deltaday = 7; + $deltatime = 3; + } + else { + $type = 'reserve_flexible'; + } + $chtxt = $chtxt_0 if ( $chtxt_0 ); if ( !&check_error ) { $dbh->do( - "INSERT INTO rectime ( type, chtxt, title, btime, etime, opt ) - VALUES ( 'res', '$chtxt', '$title', '$begin', '$end', '$opt' )" + "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime ) + VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$opt', '$deltaday', '$deltatime' )" ); } $HTML .= "録画予約を実行しました。
\n5秒後にトップへ移動します。
\n"; @@ -761,22 +1068,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 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 + "SELECT channel, epg_ch.chname, start, stop, title, category + FROM epg_timeline + INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.chtxt 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'"; + 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 ) { @@ -787,8 +1101,8 @@ if ( $mode eq 'program' ) { } if ( $category_sel ) { # 一時的 - $category_tmp = $category{$category_sel} . $category_sel; - my $category = "AND category = '$category_tmp'"; + # $category_tmp = $category{$category_sel} . $category_sel; + my $category = "AND category = '$category{$category_sel}->{name}'"; $sql =~ s/%CATEGORY%/$category/; } if ( $key ) { @@ -803,159 +1117,261 @@ if ( $mode eq 'program' ) { $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 ); + #utf8::encode( $dn ); $HTML .= qq {--------$date[1]/$date[2]($dn)--------
\n}; } - $prg->[1] = $q->url_encode( $prg->[1] ); $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] }; - $HTML .= qq {$prg->[4]
\n}; + $HTML .= qq {$prg->[1] } if ( !$chtxt ); + $HTML .= qq {$prg->[4]
\n}; $prev = $date; } - } -if ( $mode eq 'list' ) { - require File::Find; +################ mode=list ################ +if ( $mode eq 'list' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - List/; + $HTML .= qq {
\n}; - my $type = $q->param( 'type' ); - my $recording = $cfg->param( 'path.recpath' ); - my $recorded = $cfg->param( 'path.recorded' ); + $script = < + + + + +EOM + $script =~ s/^\t{2}//gm; + $HTML =~ s/%SCRIPT%/$script/; - if ( !$type ) { - $HTML .= qq {録画中のみ\n}; - $HTML .= qq {録画後のみ\n
\n}; + my $recording = $cfg->param( 'path.recpath' ); + my $ts_movepath = $cfg->param( 'path.ts_movepath' ); + my $recorded = $cfg->param( 'path.recorded' ); + + if ( $mode_sub eq 'log' ) { + my $title = $params{ 'title' }; + my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" ); + utf8::decode( $log ); + $HTML .= '
'.$log."
\n"; + goto end; + } + if ( $mode_sub eq 'logzip' ) { + my $title = $params{ 'title' }; + my $zip = Archive::Zip->new(); + my $logzip; + die 'read error' unless $zip->read("$recording/$title.log.zip") == AZ_OK; + my @members = $zip->members(); + foreach (@members) { + $logzip .= $_->fileName() . "\n"; + my @lines = split /\n|\r/, $zip->contents( $_->fileName() ); + my %count; + @lines = grep {!$count{$_}++} @lines; + $logzip .= join "\n", @lines; + $logzip .= "\n
\n"; + } + + utf8::decode( $logzip ); + $HTML .= '
'.$logzip."
\n"; + goto end; + } + if ( $mode_sub eq 'ffmpeg' ) { + my $path = $params{ 'path' }; + # mediainfo (not working) + # ffprobe + my $ffmpeg = `ffmpeg -i "$path" 2>&1`; + utf8::decode($ffmpeg); + $ffmpeg = join "
\n", grep /Duration|Stream/, split /\n/, $ffmpeg; + $HTML = $ffmpeg; + goto end; + } + if ( !$mode_sub ) { + $HTML .= qq {録画中のみ\n}; + $HTML .= qq {録画後のみ\n
\n}; } - if ( !$type || $type eq 'new' ) { + if ( !$mode_sub || $mode_sub eq 'new' ) { $HTML .= "録画中のファイル一覧
\n"; &list( $recording ); } - if ( !$type ) { + if ( !$mode_sub ) { $HTML .= "
\n"; } - if ( !$type || $type eq 'old' ) { + if ( !$mode_sub || $mode_sub eq 'old' ) { $HTML .= "録画後のファイル一覧
\n"; + &simple_list( $ts_movepath ); &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' ); + my @exp = ( 'log', 'log.zip', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log', + 'aac', 'srt', 'm2v', 'wav', '264', 'mp4', 'mkv' ); for ( 0..$#exp ) { $exp{$exp[$_]} = $_; } my $exp_count = scalar keys %exp; - File::Find::find( \&wanted, $path ); + &get_file_list_wrapper( $path, \&wanted ); + my $help; foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) { - $HTML .= $exp{$name} + 1 . " = $name / "; + $help .= $exp{$name} + 1 . " = $name / "; } - $HTML .= $exp_count+1 . qq { = サムネイル
\n○ = 完了 / ● = 書き込み中
\n}; + $HTML .= $help; + $help = qq {$help\n\n}; + $help .= qq {$_\n} for ( 1..$exp_count ); + + $HTML .= qq {
\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常
\n}; $HTML .= qq {\n\n}; $HTML .= qq {\n}; - $HTML .= qq {\n} for ( 1..$exp_count + 1 ); - $HTML .= qq {\n}; + $HTML .= qq {\n} for ( 1..$exp_count ); $HTML .= qq {\n}; - foreach ( sort keys %list ) { - my $value = $list{$_}; - my @flag = ( 0 ) x $exp_count; - $HTML .= qq {\n\n}; - foreach ( keys %{$value} ) { - my $tmp = $_; - $flag[$exp{$tmp}] = $value->{$_}; + my $count = 0; + + foreach my $title ( sort keys %list ) { + my $value = $list{$title}; + my @flag = ( 0 ) x ( $exp_count ); + $HTML .= qq {\n\n}; + foreach my $exp ( keys %{$value} ) { + if ( $exp eq 'log' ) { + # ログへのリンクを追加 + my $title = $q->escape( $title ); + my $extra = qq {\n}; + + $value->{$exp}->{extra} = $extra; + } + elsif ( $exp eq 'log.zip' ) { + # ZIPログへのリンクを追加 + my $title = $q->escape( $title ); + my $extra = qq {\n}; + + $value->{$exp}->{extra} = $extra; + } + elsif ( $exp eq 'mp4' ) { + # ○などの代わりにサイズを表示 + # $value->{$exp}->{style} = $value->{$exp}->{size}; + my $size = $value->{$exp}->{size}; + my $extra = qq {\n}; + $value->{$exp}->{extra} = $extra; + } + elsif ( $exp eq 'mkv' ) { + # サムネイルへのリンクを追加 + my $title = $q->escape( $title ); + + my $extra = qq {\n}; + $value->{$exp}->{extra} = $extra; + } + $flag[$exp{$exp}] = $value->{$exp}; } foreach ( @flag ) { - my $size = $_->{size}; - my $last = $_->{last} || '○'; - my $check = $size ? qq {$last} : '
'; - $HTML .= qq {\n}; - } - if ( $flag[$exp{mkv}] ) { - s/#/＃/g; - s/ /\+/g; - my $img = $value->{mkv}->{img}; - $HTML .= qq {\n}; - my $pre = qq {予測}; - $HTML .= qq {\n}; -# my $exe = qq {実行}; - my $exe = qq {実行}; - $HTML .= qq {\n}; - } - else { - $HTML .= qq {\n\n}; + my $size = $_->{size}; + my $style = $_->{style}; + my $span = $size ? qq {$style} : '
'; + $HTML .= $_->{extra} || qq {\n}; } $HTML .= qq {\n}; + $HTML .= $help unless ( ++$count % 20 ); } $HTML .= qq {
タイトル$_自動移動$_
$_
$title○○$size■$check■$pre$exe

$span
\n}; sub wanted { - return if ( !$_ ); - return if ( -d $File::Find::name ); - return if ( $_ eq 'Thumbs.db' ); - return if ( /\.idx/ ); - s/\.temp$//; + my $rel = shift; + my $abs = shift; + + return if ( $rel =~ /Thumbs\.db/ ); + return if ( $rel =~ /\.idx/ ); + + $rel =~ 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; + my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/; + my ( $size, $style ) = &get_size( $abs ); + $rel =~ s/\.temp$//; + if ( !$title ) { + $title = '_error_exp_'.$rel; + $exp = 'log'; } - if ( $_ =~ /mkv/ ) { - my $tmp = $title; - $tmp =~ s/#/＃/g; - $tmp =~ s/ /\+/g; - $img = $tmp; -# $img = qq {
\n}; + if ( $title !~ /[^0-9A-F]+/ ) { + my $tmp = pack( 'H*', $title ); + if ( !$tmp ) { + $title = '_error_b16_'.$rel; + $exp = 'log'; + } + else { + $title = 'Base16_'.$tmp; + } } - die $_ if ( !$title ); - $list{$title}->{$exp} = { 'last' => $last, 'size' => $size, 'img' => $img }; + $list{$title}->{$exp} = { 'style' => $style, 'size' => $size }; } } sub simple_list { + require Encode; + local $path = shift; local @list = (); - File::Find::find( \&simple_wanted, $path ); + &get_file_list_wrapper( $path, \&simple_wanted ); + +# @list = sort @list; + # natural sortを行う + #@list = map( Encode::decode_utf8( $_ ), @list ); + @list = nsort @list; + #@list = map( Encode::encode_utf8( $_ ), @list ); - @list = sort @list; foreach ( @list ) { $HTML .= "$_
\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; + my $rel = shift; + my $abs = shift; + + my ( $size ) = &get_size( $abs ); + $rel = qq {$rel}; + push @list, $rel ."\t".$result."\t". $size; } } sub get_size { my $file = shift; my ( $size, $last ) = (stat( $file ))[7,9]; - my @unim = ("B","KB","MB","GB","TB","PB"); + my @unim = ("B","KiB","MiB","GiB","TiB","PiB"); my $count = 0; while($size >= 1024 ){ @@ -966,124 +1382,447 @@ if ( $mode eq 'list' ) { $size = int( $size ); $size /= 100; if ( time - $last < 10 ) { - $last = '●'; + $style = '●'; + } + elsif ( $size == 0 ) { + $style = '◆'; } else { - $last = ''; + $style = '○'; } - return ( "$size $unim[$count]", $last ); + return ( "$size $unim[$count]", $style ); } } -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'`"; - } -} +################ 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' ); - $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; } +################ mode=check ################ + if ( $mode eq 'check' ) { } -if ( $mode eq 'expert' ) { - my $ary_ref; - my $type = $q->param( 'type' ); - $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/; +################ mode=bravia ################ + +if ( $mode eq 'bravia' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/; $HTML .= qq {
\n}; + $HTML .= qq {
\n}; + $HTML .= qq {
\n}; + $HTML .= qq {\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}; + my $order = $params{ 'order' }; + if ( $order ne 'point' ) { + $order = 'btime'; + } + else { + $order = 'point DESC'; + } + my $ary_ref = $dbh->selectall_arrayref( + "SELECT id, chtxt, title, btime, etime, point + FROM auto_timeline_bayes + ORDER BY $order" ); + + 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 {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + } + $HTML .= qq {
IDチャンネルタイトル開始時刻終了時刻録画時間ポイント予約
$line->[0]$line->[1]$line->[2]$begin$end$diff$line->[5]予約
\n}; + $HTML .= qq {
\n}; + $HTML .= qq {
\n}; + +} + +################ mode=proc ################ - if ( $type eq 'reget' ) { - my $display = $q->param( 'ch' ); - my $SQL_WHERE; - if ( $display =~ /^bs$|^cs.$/ ) { - $SQL_WHERE = "chdata.bctype = '$display'"; +if ( $mode eq 'proc' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/; + $HTML .= qq {
\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + + my $ary_ref = $dbh->selectall_arrayref( + "SELECT type, chtxt, title + FROM auto_proc + ORDER BY title " ); + + foreach my $line ( @{ $ary_ref } ) { + my $url; + $line->[3] = $q->escape( $line->[2] ); + my $opt = $dbh->selectrow_array( + "SELECT opt FROM in_timeline_log + WHERE title = '$line->[2]' " + ); + + if ( $line->[0] eq 'auto_suggest_dec' ) { + unless ( $dbh->selectrow_array( + "SELECT 1 FROM timeline + WHERE ( type = 'convert_b25_ts' OR type = 'convert_b25_ts_running' ) + AND title = '$line->[2]' " + ) ) { + $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt}; + } + } + elsif ( $line->[0] eq 'auto_suggest_enc' ) { + unless ( $dbh->selectrow_array( + "SELECT 1 FROM timeline + WHERE ( type = 'convert_ts_mp4' OR type = 'convert_ts_mp4_running' ) + AND title = '$line->[2]' " + ) ) { + $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt}; + } + } + else { + unless ( $dbh->selectrow_array( + "SELECT 1 FROM timeline + WHERE ( type LIKE 'convert_avi%' OR type = 'convert_mkv' ) + AND title = '$line->[2]' " + ) ) { + $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]}; + } + } + if ( $url ) { + $href = qq {予約}; } else { - $SQL_WHERE = "display = '$display'"; + $href = q {予約済}; + } + + my $color = $color{$type_suggest{$line->[0]}} ? $color{$type_suggest{$line->[0]}} : ''; + $line->[0] = $type{$line->[0]} ? $type{$line->[0]} : $line->[0]; + $line->[0] = qq {$line->[0]} if ( $color ); + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + } + + $HTML .= qq {
タイプタイトル予約
$line->[0]$line->[2]$href
\n}; +} + +################ mode=jbk ################ + +if ( $mode eq 'jbk' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - JBK/; + $HTML .= qq {
\n}; + + if ( $mode_sub eq 'add' ) { + my $keyword = $params{ 'keyword' }; + utf8::decode( $keyword ); + $HTML .= "キーワード「$keyword」を追加しました。
\n"; + $dbh->do( + "INSERT INTO in_auto_jbk_key ( keyword ) + VALUES ( '$keyword' )" + ); + } + elsif ( $mode_sub eq 'del' ) { + my $id = $params{ 'id' }; + my $keyword = $dbh->selectrow_array( + "SELECT keyword FROM in_auto_jbk_key + WHERE id = '$id' " ); + $HTML .= "キーワード「$keyword」を削除しました。
\n"; + $dbh->do( + "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}; + $HTML .= qq {\n}; + + my $ary_ref = $dbh->selectall_arrayref( + "SELECT id, keyword, auto, opt + FROM in_auto_jbk_key + ORDER BY id " ); + + foreach my $line ( @{ $ary_ref } ) { + 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}; + } + + $HTML .= qq {
IDキーワード自動録画切り替え録画オプション削除
$line->[0]$line->[1]$auto$oppo$line->[3]削除
\n}; + + $HTML .= qq {
\n}; + $HTML .= qq {
\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n
\n
\n
\n}; + + $HTML .= qq {\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}; + + $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 + ORDER BY btime" + , {Slice=>{}} ); + + foreach my $line ( @{ $ary_ref } ) { + 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 {
IDチャンネルタイトル開始時刻終了時刻録画時間予約
$line->{id}$line->{chname}$line->{title}$begin$end$diff予約
\n}; + +} + +################ mode=recognize ################ + +if ( $mode eq 'recognize' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/; + + my $text = $params{ 'text' }; + utf8::decode( $text ); + $chtxt = $params{ 'chtxt' }; + my $title = $params{ 'title' }; + utf8::decode( $title ); + + $HTML .= qq {
\n}; + $HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。
\n}; + $HTML .= qq {番組表が取得できない一週間以上先の予約ができます。
\n}; + $HTML .= qq {
\n}; + $HTML .= qq {
\n}; + &draw_form_channel( 'nonone' ); + $HTML .= qq {\n}; + $HTML .= qq {
\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n
\n
\n}; + + my $ch_list = join '|', grep /.+/, values %chtxt_0_chname; + my %ch_reverse = reverse %chtxt_0_chname; + + if ( $text ) { + my ( $year, $month, $day ); + my ( $bhour, $bminute, $ehour, $eminute ); + my $next_day = 0; + foreach ( split /\n/, $text ) { + 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 ( !@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 (!( @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_reverse{$ch} if ( $ch && $ch_reverse{$ch} ); + s/($ch_list)//; + + 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 = 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 $bhour:$bminute -> $ehour:$eminute 残り:$_リンク
\n}; + } } - 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' " ); + } +} + +################ mode=expert ################ + +if ( $mode eq 'expert' ) { + require List::Compare; + + my $ary_ref; + + $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/; + $HTML .= qq {
\n}; + + if ( $mode_sub eq 'reget' ) { + my $bctype = $params{ 'bctype' }; + my ( $chtxt, $chname ) = $dbh->selectrow_array( + "SELECT chtxt, chname FROM epg_ch + WHERE bctype = '$bctype' " ); + $HTML .= "Update for $chname ( chtxt: $chtxt ) has been reserved.
\n"; + $dbh->do( "UPDATE epg_ch SET status = '2' WHERE chtxt = '$chtxt' " ); goto end; } + my @ary = $dbh->selectrow_array( + "SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt + FROM in_settings " ); + my $opt = pop @ary; + @ary = map( $_ ? 'checked' : '', @ary ); + + $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
\n
\n}; + + + $HTML .= qq {
\n番組表のカテゴリ一覧と内蔵のカテゴリ一覧の合致を確認中...\n}; $ary_ref = $dbh->selectcol_arrayref( - "SELECT DISTINCT category FROM tv" + "SELECT DISTINCT category FROM epg_timeline" ); - # 一時的 - my @category = map { $category{$_} . $_ } sort keys %category; - # my @category = sort keys %category; - $HTML .= qq {
\n番組表のカテゴリ一覧と内蔵の一覧の合致を確認中...\n}; - # $HTML .= qq {番組表：@{$ary_ref}
\n内蔵：@category
\n}; + my @category = map {$_->{name}} sort values %category; if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) { $HTML .= qq {一致しません
\n}; + $HTML .= qq {番組表：@{$ary_ref}
\n内蔵：@category
\n}; } else { $HTML .= qq {一致しました
\n}; } - my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM 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}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n
\n
\n}; + + + $HTML .= qq {
\nRec10 バージョン：$rec10_version\nrectool バージョン：$rectool_version\n
\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 .= "
\n番組表の欠落
\n"; + $HTML .= qq {
\n番組表の欠落
\n}; + $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" ); 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 $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop, title FROM epg_timeline 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->[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; } $HTML .= qq {
\n$line->[0]\n$error
\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 + "SELECT chname, chtxt, bctype, ch, csch, updatetime, status, visible + FROM epg_ch ORDER BY bctype " ); $HTML .= qq {
\n番組表の更新状況
\n}; $HTML .= qq {\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}; @@ -1097,13 +1836,14 @@ if ( $mode eq 'expert' ) { $HTML .= qq {
\n}; $HTML .= qq {番組表を再取得する\n}; $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; + $HTML .= qq {
チャンネル名チャンネルコードontvコードタイプchtxtbctypechcsch最終更新時刻状態表示
\n\n}; @@ -1125,6 +1865,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}; @@ -1132,11 +1873,45 @@ 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 {
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/; + + $HTML .= qq {
\n}; + $HTML .= qq {\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}; + $ary_ref = $dbh->selectall_arrayref( + "SELECT id, chtxt, title, btime, etime, opt, exp, longexp, category + FROM in_timeline_log " + ); + foreach my $line ( @{$ary_ref} ) { + $HTML .= qq {\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + } + $HTML .= qq {
IDchtxttitlebtimeetimeoptexplongexpcategory
$line->[0]$line->[1]$line->[2]$line->[3]$line->[4]$line->[5]$line->[6]$line->[7]$line->[8]
\n}; +} + +################ mode=help ################ + if ( $mode eq 'help' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Help/; $HTML =~ s|%REFRESH%||; @@ -1144,13 +1919,14 @@ if ( $mode eq 'help' ) { $HTML .= qq {ヘルプ\n}; } +################ mode=test ################ + if ( $mode eq 'test' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Test/; $HTML =~ s|%REFRESH%||; $HTML .= qq {
\n}; require Data::Dumper; - require Perl6::Slurp; $tmp = Perl6::Slurp::slurp( 'config.ini' ); $tmp =~ s/\n/
\n/gs; $HTML .= $tmp; @@ -1158,6 +1934,8 @@ if ( $mode eq 'test' ) { # $HTML .= Dumper( $ary_ref ); } +################ mode nasi ################ + if ( !$mode ) { &draw_form(); $HTML =~ s/%HTML_TITLE_OPT%/ - Top/; @@ -1175,35 +1953,8 @@ $HTML .= < -$HTML_ADV_TEXT = < - - -EOM - -$HTML_ADV_IMG = < - - -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(); @@ -1213,55 +1964,58 @@ $HTML =~ s/%SCRIPT%//; $HTML =~ s/%CSS%//; $HTML =~ s/%HTML_HEADER%/$HTML_HEADER/; +utf8::encode( $HTML ); print $HTTP_HEADER; print $HTML; +exit; sub draw_menu { $hires = Time::HiRes::time() - $hires; $last_modified = localtime((stat 'rectool.pl')[9]); $HTML_HEADER .= qq {
\n}; - $HTML_HEADER .= qq {Last-Modified: $last_modified
Time-Elasped: $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}; -# $HTML_HEADER .= qq {新規予約\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}; + $HTML_HEADER .= qq {文字認識\n}; + $HTML_HEADER .= qq {新規予約\n}; +# $HTML_HEADER .= qq {新規予約\n}; $HTML_HEADER .= qq {\n}; $HTML_HEADER .= qq {
\n}; $HTML_HEADER .= qq {
\n}; } sub draw_form { - $channel = $dbh->selectrow_array("SELECT channel FROM ch WHERE display = '$display' "); + $chname = $params{ 'chname' }; + $chtxt = $params{ 'chtxt' }; + $key = $params{ 'key' }; + utf8::decode( $key ); + if ( $chname ) { + $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname' "); + } - # チャンネル指定 $HTML .= qq {
\n}; $HTML .= qq {
\n}; $HTML .= qq {
\n}; $HTML .= qq {\n}; - $HTML .= qq {\n}; + + # チャンネル指定 + &draw_form_channel(); # 日付指定 $HTML .= qq {\n\n}; - $category_sel = $q->param( 'category' ); + $category_sel = $params{ 'category' }; foreach my $category ( keys %category ) { if ( $category eq $category_sel ) { - $HTML .= qq {\n}; + $HTML .= qq {\n}; } else { - $HTML .= qq {\n}; + $HTML .= qq {\n}; } } $HTML .= qq {\n}; # キーワード指定 - $HTML .= qq {\n}; + $HTML .= qq {\n}; # フォーム描画 - $HTML .= qq {\n
\n
\n}; + $HTML .= qq {\n
\n\n}; +} + +sub draw_form_channel { + $HTML .= qq {\n}; +} + +sub draw_form_opt { + my $shift = shift; + my ( %selected, %checked ); + + if ( $chtxt =~ /BS_103/ ) { + $selected{F} = 'selected'; + } + elsif ( $chtxt =~ /CS_239|CS_240|CS_335/ ) { + $selected{H} = 'selected'; + } + elsif ( $chtxt =~ /BS_101|BS_102/ || $bctype =~ /cs/ ) { + $selected{W} = 'selected'; + } + elsif ( $bctype =~ /bs|te/ ) { + $selected{H} = 'selected'; + } + $selected{g} = 'selected'; + $selected{s} = 'selected'; + $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{2} = 'checked'; + + if ( $opt ) { + undef %checked; + undef %selected; + my @opt = split //, $opt; + foreach my $opt ( @opt ) { + $selected{$opt} = 'selected' if ( $opt =~ /S|L|G|H|F/ ); + $checked {$opt} = 'checked' if ( $opt =~ /a|h|l|d|2|5/ ); + } + $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 {\n}; + + $HTML .= qq {\n}; + + $HTML .= qq {\n}; + + $HTML .= qq {24fps(主にアニメ)\n}; + $HTML .= qq {二ヶ国語放送\n}; + #$HTML .= qq {2passモード\n}; + $HTML .= qq {5.1ch放送\n}; + $HTML .= qq {
\n}; + $HTML .= qq {\n}; + $HTML .= qq {ファイル名日時追加\n} if ( $shift eq 'reserve' ); + $HTML .= qq {隔週録画\n} if ( $shift eq 'reserve' ); } 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%'; + $chname = $params{ 'chname' }; + $chtxt = $params{ 'chtxt' }; + $start = $params{ 'start' }; + $stop = $params{ 'stop' }; + $bayesid = $params{ 'bayesid' }; + $id = $params{ 'id' }; + + if ( $chname ) { + $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 ) { + $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'"); + } + + if ( $bayesid ) { + ( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array( + "SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' " + ); + ( $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 = '$chtxt' AND start = '$start' AND stop = '$stop' " + ); + } + if ( $id ) { + ( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt, $counter ) = $dbh->selectrow_array( + "SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter + FROM timeline WHERE id = '$id' " + ); + ( $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 = '$chtxt' AND start = '$start' AND stop = '$stop' " + ); + } + if ( $bctype =~ /bs|cs/ ) { + $bctype_sql = '_s%'; } elsif ( $bctype =~ /te/ ) { - $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 {\n}; } sub check_error { - my $is_error = 1; + my $is_error; + my $is_same = $dbh->selectrow_array( + "SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'" + ); my @overlap = &get_overlap(); - if ( $dbh->selectrow_array( - "SELECT COUNT(*) FROM rectime - WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'" - ) ) { + if ( $is_same ) { $HTML .= "同一の番組が既に存在します。
\n"; + $is_error = 1; } elsif ( $overlap[0] >= 2 ) { $HTML .= "時間が被る番組が既に2個存在します。
\n"; $HTML .= $overlap[1]; + $is_error = 2; } else { $is_error = 0; @@ -1337,9 +2258,9 @@ sub get_overlap { 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' ) + FROM timeline + INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt + WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made AND btime < '$end' AND etime > '$begin' " @@ -1349,7 +2270,7 @@ sub get_overlap { my $overlap = $max = 0; my $str; foreach my $prg ( @{ $ary_ref } ) { - $str .= "$prg->[0] 〜 $prg->[1] : $prg->[2]
\n"; + $str .= "$prg->[0] ? $prg->[1] : $prg->[2]
\n"; $overlap{$prg->[0]} += 1; $overlap{$prg->[1]} -= 1; } @@ -1365,20 +2286,122 @@ sub get_overlap { } } +sub get_file_list_wrapper { + local $base_dir = shift; + local $ptr = shift; + + &get_file_list( $base_dir ); +} + +sub get_file_list{ + my $dir = shift; + + opendir ( DIR, $dir ); + my @list = sort readdir( DIR ); + closedir( DIR ); + + foreach my $file ( @list ) { + next if ( $file =~ /^\.{1,2}$/ ); + if ( -d "$dir/$file" ){ + &get_file_list("$dir/$file"); + } + else{ + $abs = "$dir/$file"; + utf8::decode( $abs ); + ( $rel ) = $abs =~ /^$base_dir\/(.*)$/; + $ptr->( $rel, $abs ); + } + } +} + +sub strisjoined { + my $str = shift; + + return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1; +} + sub str2datetime { my $str = shift; - my $joined = shift; my @time; - if ( $joined ) { + if ( strisjoined( $str ) ) { @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], + year => $time[0], month => $time[1], day => $time[2], + hour => $time[3], minute => $time[4], second => $time[5], + locale => 'ja_JP' , time_zone => $tz ); } +sub str2dayname { + my $str = shift; + our %day_name_cache; + + if ( !$day_name_cache{$str} ) { + $day_name_cache{$str} = str2datetime( $str )->day_name; + } + return $day_name_cache{$str}; +} + +sub str2readable { + my $begin = shift; + my $end = shift; + + my $dt_begin = ref( $begin ) eq 'DateTime' ? $begin : &str2datetime( $begin ); + my $dt_end = ref( $end ) eq 'DateTime' ? $end : &str2datetime( $end ); + + 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 ); + + my ( $sec, $min, $hour ); + $sec = $dt_end->epoch - $dt_begin->epoch; + $min = int( $sec / 60 ); + $sec = $sec - $min * 60; + $hour = int( $min / 60 ); + $min = $min - $hour * 60; + my $str_diff = ''; + $str_diff .= $hour . '時間' if ( $hour ); + $str_diff .= $min . '分' if ( $min ); + $str_diff .= $sec . '秒' if ( $sec ); + + return ( $str_begin, $str_end, $str_diff ); +} + +sub sqlgetsuggested { + require Encode; + require Text::Ngram; + + my ( $btime, $etime ) = @_; + $deltatime = 3 if ( !$deltatime ); + + $btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); + $btime_end = $btime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); + $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' ); + + $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop, title, exp + FROM epg_timeline + 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( $title, 2 ); # bi-gram + foreach my $program ( @{$ary_ref} ) { + 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 ); + } + + return %hash; +} +