From 214d292af027adeeaaad9359ea453de9eeb4c0ec Mon Sep 17 00:00:00 2001 From: longinus Date: Mon, 22 Feb 2010 09:44:07 +0000 Subject: [PATCH] add some functions git-svn-id: svn+ssh://svn.sourceforge.jp/svnroot/rec10@446 4e526526-5e11-4fc0-8910-f8fd03428081 --- rectool/trunk/Makefile.PL | 12 +- rectool/trunk/rectool.pl | 744 ++++++++++++++++++++++++++++++---------------- 2 files changed, 501 insertions(+), 255 deletions(-) diff --git a/rectool/trunk/Makefile.PL b/rectool/trunk/Makefile.PL index 4278d4d..57398cc 100755 --- a/rectool/trunk/Makefile.PL +++ b/rectool/trunk/Makefile.PL @@ -18,9 +18,9 @@ elsif ( $distribution =~ /debian/m ) { } if ( $redhat ) { - my $YUM = 'perl-DBI perl-Date-Simple perl-DateTime perl-Config-Simple perl-Tie-IxHash perl-SVG perl-XML-Atom perl-List-Compare'; - my $CPAN = 'CGI::Carp CGI::Minimal MIME::Base64 Time::HiRes Data::Dumper Time::Simple Encode Text::Ngram File::Find Perl6::Slurp List::Util'; - print "Going to install ( yum )\n"; + my $YUM = 'perl-DBI perl-Date-Simple perl-DateTime perl-Config-Simple perl-Tie-IxHash perl-SVG perl-XML-Atom perl-List-Compare perl-Time-Piece perl-Sort-Naturally'; + my $CPAN = 'CGI::Carp CGI::Minimal MIME::Base64 Time::HiRes Data::Dumper Time::Simple Encode Text::Ngram Perl6::Slurp List::Util Time::Seconds'; + print "Going to install ( YUM )\n"; print "$YUM\n"; system( "yum install $YUM" ); print "Going to install ( CPAN )\n"; @@ -29,9 +29,9 @@ if ( $redhat ) { } if ( $debian ) { - my $APT = 'libdbi-perl libdate-simple-perl libdatetime-perl libmime-base64-perl libconfig-simple-perl libtime-hires-perl libtie-ixhash-perl libsvg-perl libxml-atom-perl liblist-compare-perl libperl6-slurp-perl'; - my $CPAN = 'CGI::Carp CGI::Minimal Data::Dumper Time::Simple Encode Text::Ngram File::Find List::Util'; - print "Going to install ( aptitude )\n"; + my $APT = 'libdbi-perl libdate-simple-perl libdatetime-perl libmime-base64-perl libconfig-simple-perl libtime-hires-perl libtie-ixhash-perl libsvg-perl libxml-atom-perl liblist-compare-perl libperl6-slurp-perl libtime-piece-perl libsort-naturally-perl'; + my $CPAN = 'CGI::Carp CGI::Minimal Data::Dumper Time::Simple Encode Text::Ngram List::Util Time::Seconds'; + print "Going to install ( APT )\n"; print "$APT\n"; system( "aptitude install $APT" ); print "Going to install ( CPAN )\n"; diff --git a/rectool/trunk/rectool.pl b/rectool/trunk/rectool.pl index 69319a2..56fc562 100755 --- a/rectool/trunk/rectool.pl +++ b/rectool/trunk/rectool.pl @@ -1,15 +1,16 @@ #!/usr/bin/perl # -d:SmallProf -#use Perl6::Slurp; #use XML::Simple; #use CGI; #use CGI::Lite; #use Date::Manip; #Date_Init("TZ=JST","ConvTZ=JST"); -#use SVG; #use KCatch; use CGI::Carp qw( fatalsToBrowser ); +use warnings; use DBI; +use Time::Piece; +use Time::Seconds; use Date::Simple; use DateTime; use CGI::Minimal; @@ -18,7 +19,9 @@ use Config::Simple; use Time::HiRes; use Data::Dumper; use Tie::IxHash; -#require SVG Time::Simple Encode Text::Ngram File::Find Data::Dumper Perl6::Slurp List::Util +use Perl6::Slurp; +use Sort::Naturally; +#require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util #use utf8; %DB::packages = ( 'main' => 1 ); my $tz = DateTime::TimeZone->new( name => 'local' ); @@ -28,9 +31,6 @@ my $cfg = new Config::Simple; if ( -e '/etc/rec10.conf' ) { $cfg->read( '/etc/rec10.conf' ); } -else { - $cfg->read( 'config.ini' ); -} my $sql = $cfg->param( 'db.db' ); @@ -47,6 +47,7 @@ if ( $sql eq 'MySQL' ) { $dbh->do( 'SET NAMES utf8' ); } + my $HTML; #print "Content-Type: text/html\n\n"; @@ -57,9 +58,10 @@ $HTML .= < Rec10%HTML_TITLE_OPT% + - + %REFRESH% @@ -70,11 +72,42 @@ $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; + $HTML .= qq {
\n $tmp}; + $HTML =~ s/%HTML_TITLE_OPT%/ - $ENV{'HTTP_AUTHORIZATION'}/; + goto end; +} $q = new CGI::Minimal; $mode = $q->param( 'mode' ); $mode_sub = $q->param( 'mode_sub' ); + tie %type, 'Tie::IxHash'; %type = ( 'search_everyday' => '隔日検索', @@ -113,6 +146,21 @@ tie %type, 'Tie::IxHash'; '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' )"; %category = ( @@ -155,7 +203,7 @@ EOM INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt ORDER BY $order"); - $HTML .= qq {
\n}; + $HTML .= qq {
\n}; $HTML .= qq {
\n}; $HTML .= qq {
\n}; $HTML .= qq {\n}; @@ -180,26 +228,9 @@ EOM $line->[9] = qq {空} if ( !$line->[9] && $line->[1] eq 'search_everyday' ); $line->[10] = qq {空} if ( !$line->[10] ); } - elsif ( $line->[1] eq 'reserve_running' ) { - $type = qq {$type}; - } - elsif ( $line->[1] =~ /^reserve/ ) { - $type = qq {$type}; - } - elsif ( $line->[1] eq 'convert_b25_ts' ) { - $type = qq {$type}; - } - elsif ( $line->[1] eq 'convert_b25_ts_running' ) { - $type = qq {$type}; - } - elsif ( $line->[1] eq 'convert_ts_mp4' ) { - $type = qq {$type}; - } - elsif ( $line->[1] eq 'convert_ts_mp4_running' ) { - $type = qq {$type}; - } else { - $type = qq {$type}; + my $color = $color{$line->[1]} ? $color{$line->[1]} : $color{'other'}; + $type = qq {$type}; } $chname_encoded = $q->url_encode( $line->[4] ); $line->[5] = 'タイトルなし' if ( !$line->[5] ); @@ -221,47 +252,23 @@ EOM if ( $ary[0] ne $line->[5] ) { my $count = $ary[0] =~ s/\Q$line->[5]\E//; if ( !$count ) { - $ary[0] = qq {$ary[0]}; + my $href = qq {自動検索}; + $ary[0] = qq {$ary[0]■$href■}; } } else { $ary[0] = '説明'; } - if ( $ary[1] ) { - $line->[11] = qq {
$ary[0]
}; - } - else { - $line->[11] = qq {説明なし}; - } + $line->[11] = qq {
$ary[0]
}; } else { my $href = qq {自動検索}; - $line->[11] = qq {！$href！}; + $line->[11] = qq {■$href■}; } } - my $begin = $unix_6->strftime( '%m/%d(%a) %H:%M' ); - utf8::encode( $begin ); - my $end; - if ( $unix_6->month == $unix_7->month && $unix_6->day == $unix_7->day ) - { - $end = $unix_7->strftime( '%H:%M' ); - } - else { - $end = $unix_7->strftime( '翌 %H:%M' ); - } - - my ( $sec, $min, $hour ); - $sec = $unix_7->epoch - $unix_6->epoch; - $min = int( $sec / 60 ); - $sec = $sec - $min * 60; - $hour = int( $min / 60 ); - $min = $min - $hour * 60; - my $diff = ''; - $diff .= $hour . '時間' if ( $hour ); - $diff .= $min . '分' if ( $min ); - $diff .= $sec . '秒' if ( $sec ); + my ( $begin, $end, $diff ) = &str2readable( $unix_6, $unix_7 ); my $hr; if ( @@ -275,13 +282,13 @@ EOM $hr .= qq { background-color: blue; border: none" title="$percent%">}; } - $line->[5] = qq {
$line->[5]
} if ( $line->[11] ); $line->[5] = qq {$line->[5]}; +# $line->[5] = qq {
$line->[5]
} if ( $line->[11] ); $HTML .= qq {\n}; $HTML .= qq {\n}; $HTML .= qq {$line->[0]\n}; $HTML .= qq {$type\n}; - $HTML .= qq {$line->[2]\n}; + $HTML .= qq {$line->[2]\n}; $HTML .= qq {$line->[5]$line->[11]\n}; $HTML .= qq {$begin\n$end\n}; $HTML .= qq {$hr$diff\n}; @@ -296,19 +303,19 @@ EOM if ( $mode eq 'graph' ) { - $graph = $q->param( 'graph' ); + my $date = $q->param( '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; - + $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} = 2; #$cfg->param( 'env.te_max' ); $tuner{satellite} = 4; #$cfg->param( 'env.bscs_max' ); $tuner{all} = $tuner{terrestrial} + $tuner{satellite}; @@ -332,7 +339,7 @@ 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' } ); } @@ -450,7 +457,7 @@ if ( $mode eq 'graph' ) { my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name; utf8::encode( $dn ); $HTML .= qq {$date[1]/$date[2]($dn)の予約状況
\n}; - $HTML .= qq {\n}; + $HTML .= qq {\n}; $HTML .= qq {SVG Image $date\n\n
\n}; $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d'); @@ -474,35 +481,70 @@ if ( $mode eq 'atom' ) { require XML::Atom::Feed; require XML::Atom::Entry; - my $recording_status; + 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]}; + $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; + my $feed = XML::Atom::Feed->new( Version => 1.0 ); $feed->title('Rec10 フィード'); - my $entry = XML::Atom::Entry->new; - $entry->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; - $entry->title('Test'); - $entry->id('testid'); - $entry->content('TestData'); + $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; + } } if ( $mode eq 'edit' ) { @@ -609,7 +651,7 @@ EOM $HTML .= qq {ID\n\n}; $HTML .= qq {タイプ\n\n}; $HTML .= qq {チャンネル\n
\n}; @@ -712,19 +754,33 @@ if ( $mode eq 'change' ) { if ( $mode_sub eq 'move' ) { my $mode_sub2 = $q->param( 'mode_sub2' ); my $title = $q->param( 'title' ); - $title =~ s/＃/#/g; - $title =~ s/\+/ /g; $ENV{'LANG'} = 'ja_JP.UTF-8'; if ( $mode_sub2 eq 'predict' ) { - eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "classify.py -s '$title'`"; + $HTML .= "移動後のシミュレーション結果です。\n
"; + eval '$HTML .= `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 '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`"; } 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' ) || ''; + + $dbh->do( + "INSERT INTO in_settings ( auto_jbk, auto_bayes, auto_del_tmp, auto_opt ) + VALUES ( '$jbk', '$bayes', '$del_tmp', '$opt' )" + ); + + goto end; + } } @@ -735,6 +791,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"; if ( $longdesc ) { $longdesc =~ s/\\n/
\n/gs; @@ -756,52 +813,20 @@ if ( $mode eq 'confirm' ) { $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 {可能}; + qq {可能}; $HTML .= "開始：$begin\n終了：$end\n録画は$overlap
\n"; } } } else { - if ( $chtxt =~ /\Qbs-nhk-hi\E/ ) { - $selected_f = 'selected'; - } - elsif ( $chtxt =~ /movieplus/ ) { - $selected_h = 'selected'; - } - else { - $selected_g = 'selected'; - } - $checked_v = $chtxt =~ /animax|atx|disney|kids/ || $category =~ /アニメ/ ? 'checked' : ''; - $checked_d = $title =~ /\Q[二]\E|［二］|\Q(二)\E|（二）/ ? 'checked' : ''; - $checked_5 = $title =~ /5\.1|5．1/ ? 'checked' : ''; - $checked_2 = 'checked'; - $HTML .= "録画予約の詳細設定を行ってください。
\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 {
\n}; - $HTML .= qq {\n}; - $HTML .= qq {ファイル名日時追加\n}; - $HTML .= qq {隔週録画\n}; + $HTML .= qq {\n} if ( $q->param( 'title' ) ); + &draw_form_opt( 'reserve' ); $HTML .= qq {\n\n}; } goto end; @@ -809,9 +834,10 @@ if ( $mode eq 'confirm' ) { # End of $mode_sub eq 'reserve'; if ( $mode_sub eq 'proc' ) { - my $type = $q->param( 'type' ); - my $chtxt = $q->param( 'chtxt' ); - my $title = $q->param( 'title' ); + my $type = $q->param( 'type' ); + local $chtxt = $q->param( 'chtxt' ); + my $title = $q->param( 'title' ); + local $opt = $q->param( 'opt' ); $HTML .= "詳細設定を行ってください。
\n"; $HTML .= "タイトル：$title\n
\n"; @@ -821,31 +847,8 @@ if ( $mode eq 'confirm' ) { $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}; + &draw_form_channel( 'nonone' ); + &draw_form_opt(); $HTML .= qq {\n\n}; goto end; } @@ -854,19 +857,24 @@ if ( $mode eq 'confirm' ) { if ( $mode eq 'reserve' ) { $HTML .= qq {
\n}; &parse_program(); + $title = $q->param( 'title' ) if ( !$title ); @opt = $q->param( 'opt' ); $opt = join '', @opt; my ( $deltaday, $deltatime ); - $deltaday = 7; + if ( $q->param('every') eq '1' ) { $type = 'search_everyday'; - ( $changed_t ) = $title =~ /(.*) #/; + ( $changed_t ) = $title =~ /(.*)#/; $title = $changed_t if ( $changed_t ); - ( $changed_t ) = $title =~ /(.*) 第/; + ( $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/\s*$//; $deltaday = 7; $deltatime = 3; } @@ -890,7 +898,7 @@ if ( $mode eq 'program' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/; $unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' ); $sql = - "SELECT channel, chname, start, stop, title, category + "SELECT channel, chtxt, chname, start, stop, title, category FROM epg_timeline INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.ontv WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start"; @@ -922,7 +930,7 @@ 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})/; + my @date = $prg->[3] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/; $date = $date[2]; if ( $date != $prev ) { @@ -935,23 +943,27 @@ if ( $mode eq 'program' ) { utf8::encode( $dn ); $HTML .= qq {--------$date[1]/$date[2]($dn)--------
\n}; } - $prg->[5] = $q->url_encode( $prg->[1] ); $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] }; - $HTML .= qq {$prg->[1] } if ( !$ontv ); - $HTML .= qq {$prg->[4]
\n}; + $HTML .= qq {$prg->[2] } if ( !$ontv ); + $HTML .= qq {$prg->[5]
\n}; $prev = $date; } } if ( $mode eq 'list' ) { - require File::Find; - $HTML =~ s/%HTML_TITLE_OPT%/ - List/; + $HTML .= qq {
\n}; my $recording = $cfg->param( 'path.recpath' ); my $recorded = $cfg->param( 'path.recorded' ); + if ( $mode_sub eq 'log' ) { + my $title = $q->param( 'title' ); + my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" ); + $HTML .= '
'.$log."
\n"; + goto end; + } if ( !$mode_sub ) { $HTML .= qq {録画中のみ\n}; $HTML .= qq {録画後のみ\n
\n}; @@ -972,116 +984,134 @@ if ( $mode eq 'list' ) { local $path = shift; local %list = (); my @exp = ( 'log', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log.mbtree', 'ts.log', - 'sa.avi', 'sa.avi.log', '120.avi', 'aac', 'timecode.txt', 'm2v', 'wav', 'avi', 'mkv', 'mp4' ); + 'sa.avi', 'sa.avi.log', 'aac', 'srt', 'm2v', 'wav', 'avi', 'mkv' ); for ( 0..$#exp ) { $exp{$exp[$_]} = $_; } my $exp_count = scalar keys %exp; - my %opt = ( follow => 1, wanted => \&wanted, ); - File::Find::find( \%opt, $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 ); + $help .= qq {自動移動\n\n}; + $help .= qq {\n\n}; + + $HTML .= qq {
\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常
\n}; $HTML .= qq {\n\n}; $HTML .= qq {\n}; - $HTML .= qq {\n} for ( 1..$exp_count + 1 ); + $HTML .= qq {\n} for ( 1..$exp_count ); $HTML .= qq {\n}; $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->url_encode( $title ); + my $check = qq {\n}; + + $value->{$exp}->{check} = $check; + } + elsif ( $exp eq 'mkv' ) { + my $title = $q->url_encode( $title ); + + my $check = qq {\n}; + $value->{$exp}->{check} = $check; + } + $flag[$exp{$exp}] = $value->{$exp}; + } + if ( !$flag[$exp{'mkv'}] ) { + $flag[@flag]->{check} = qq {\n}; + } + else { + my $title = $q->url_encode( $title ); + + $flag[@flag]->{check} = + qq {\n}. + qq {\n}; } foreach ( @flag ) { my $size = $_->{size}; my $last = $_->{last} || ( $_->{size} eq '0 B' ? '◆' : '○' ); - my $check = $size ? qq {$last} : '
'; - $HTML .= qq {\n}; - } - if ( $flag[$exp{mp4}] ) { - s/#/＃/g; - s/ /\+/g; - my $img = $value->{mp4}->{img}; - $HTML .= qq {\n}; - my $pre = qq {予測}; - $HTML .= qq {\n}; - my $exe = qq {実行}; - $HTML .= qq {\n}; - } - else { - $HTML .= qq {\n\n}; + my $check = $size ? qq {$last} : '
'; + $HTML .= $_->{check} ? $_->{check} : qq {\n}; } $HTML .= qq {\n}; + $HTML .= $help unless ( ++$count % 20 ); } $HTML .= qq {
タイトル$_$_自動移動
$_
$title○■
予測実行$check■$pre$exe

$check
\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$//; + my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/; + my ( $size, $last ) = &get_size( $abs ); + $rel =~ s/\.temp$//; if ( !$title ) { - $title = '_error_exp_'.$_; + $title = '_error_exp_'.$rel; $exp = 'log'; } if ( $title !~ /[^0-9A-F]+/ ) { my $tmp = pack( 'H*', $title ); if ( !$tmp ) { - $title = '_error_b16_'.$_; + $title = '_error_b16_'.$rel; $exp = 'log'; } else { $title = 'Base16_'.$tmp; } } - if ( $_ =~ /mp4/ ) { - my $tmp = $title; - $tmp =~ s/#/＃/g; - $tmp =~ s/ /\+/g; - $img = $tmp; - } - $list{$title}->{$exp} = { 'last' => $last, 'size' => $size, 'img' => $img }; + $list{$title}->{$exp} = { 'last' => $last, '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 ); + push @list, $rel ."\t\t". $size; } } sub get_size { my $file = shift; my ( $size, $last ) = (stat( $file ))[7,9]; - my @unim = ("B","KB","MB","GB","TB","PB"); + my @unim = ("B","KiB","MiB","GiB","TiB","PiB"); my $count = 0; while($size >= 1024 ){ @@ -1105,11 +1135,9 @@ if ( $mode eq 'thumb' ) { my $title = $q->param( 'title' ); my $pos = $q->param( 'pos' ); my $recording = $cfg->param( 'path.recpath' ); - $title =~ s/\+/ /g; - $title =~ s/＃/#/g; print "Content-Type: image/jpeg\n\n"; - exec "ffmpeg -ss 300 -i '$recording/$title.mp4' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -"; + exec "ffmpeg -ss 300 -i '$recording/$title.mkv' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -"; exit; } @@ -1173,23 +1201,58 @@ if ( $mode eq 'proc' ) { my $ary_ref = $dbh->selectall_arrayref( "SELECT type, chtxt, title - FROM auto_proc " ); + FROM auto_proc + ORDER BY title " ); foreach my $line ( @{ $ary_ref } ) { my $url; $line->[3] = $q->url_encode( $line->[2] ); + my $opt = $dbh->selectrow_array( + "SELECT opt FROM in_timeline_log + WHERE title = '$line->[2]' " + ); - if ( $line->[0] =~ /^auto_suggest_(dec|enc)/ ) { - $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]}; + 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=change&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]}; + } + } + if ( $url ) { + $href = qq {予約}; } else { - $url = qq {rectool.pl?mode=change&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]}; + $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 {$line->[0]\n}; - $HTML .= qq {$line->[2]\n}; - $HTML .= qq {予約\n}; + $HTML .= qq {$line->[2]\n}; + $HTML .= qq {$href\n}; $HTML .= qq {\n}; } @@ -1284,7 +1347,52 @@ if ( $mode eq 'jbk' ) { } +if ( $mode eq 'recognize' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/; + + my $text = $q->param( 'text' ); + $chtxt = $q->param( 'chtxt' ); + my $title = $q->param( '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}; + + if ( $text ) { + my ( $year, $month, $day ); + my ( $hour, $minute ); + foreach ( split /\n/, $text ) { + my @date = /(\d{4}).(\d{2}).(\d{2})/; + my @time = /(\d{1,2})[:：](\d{2})/; + s/(\d{4}).(\d{2}).(\d{2})//; + s/(\d{1,2})[:：](\d{2})//; + s/\(.*\)//; + 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] ); + if ( $year && $month && $day && defined $hour && defined $minute ) { + my $tp = Time::Piece->strptime( "$year-$month-$day $hour:$minute", '%Y-%m-%d %H:%M' ); + my $start = $tp->strftime( '%Y%m%d%H%M%S' ); + my $stop = ( $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}; + } + } + } +} + if ( $mode eq 'expert' ) { + require List::Compare; + my $ary_ref; $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/; @@ -1301,11 +1409,27 @@ if ( $mode eq 'expert' ) { } + 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}; + + $ary_ref = $dbh->selectcol_arrayref( "SELECT DISTINCT category FROM epg_timeline" ); - # 一時的 - # my @category = map { $category{$_} . $_ } sort keys %category; my @category = sort values %category; $HTML .= qq {
\n番組表のカテゴリ一覧と内蔵の一覧の合致を確認中...\n}; if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) { @@ -1319,7 +1443,6 @@ if ( $mode eq 'expert' ) { my @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}; - use List::Compare; $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" ); my $prev; $HTML .= "
\n番組表の欠落
\n"; @@ -1333,8 +1456,8 @@ 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] !~ /クロ?ジング|クロージング|エンディング|休止|ミッドナイト/ && + $program_new->[2] !~ /オープニング|ウィークリー・インフォメーション|モーニング/ && ( 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/; @@ -1413,6 +1536,35 @@ if ( $mode eq 'expert' ) { $HTML .= qq {\n}; } +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}; +} + if ( $mode eq 'help' ) { $HTML =~ s/%HTML_TITLE_OPT%/ - Help/; $HTML =~ s|%REFRESH%||; @@ -1425,8 +1577,6 @@ if ( $mode eq '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; @@ -1463,13 +1613,14 @@ $HTML =~ s/%HTML_HEADER%/$HTML_HEADER/; 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}; @@ -1479,6 +1630,7 @@ sub draw_menu { $HTML_HEADER .= qq {玄人仕様\n}; $HTML_HEADER .= qq {復旧支援\n}; $HTML_HEADER .= qq {地引\n}; + $HTML_HEADER .= qq {文字認識\n}; $HTML_HEADER .= qq {新規予約\n}; $HTML_HEADER .= qq {新規予約2\n}; $HTML_HEADER .= qq {\n}; @@ -1488,8 +1640,14 @@ sub draw_menu { sub draw_form { $chname = $q->param( 'chname' ); + $chtxt = $q->param( 'chtxt' ); $key = $q->param( 'key' ); - $ontv = $dbh->selectrow_array("SELECT ontv FROM epg_ch WHERE chname = '$chname' "); + 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' "); + } $HTML .= qq {
\n}; $HTML .= qq {
\n}; @@ -1497,19 +1655,7 @@ sub draw_form { $HTML .= qq {\n}; # チャンネル指定 - $HTML .= qq {\n}; + &draw_form_channel(); # 日付指定 $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 =~ /\Qbs-nhk-hi\E/ ) { + $selected{F} = 'selected'; + } + elsif ( $chtxt =~ /movieplus|nihoneiga/ ) { + $selected{G} = 'selected'; + } + elsif ( $chtxt =~ /bs-nhk/ || $bctype =~ /cs/ ) { + $selected{L} = 'selected'; + } + elsif ( $bctype =~ /bs|te/ ) { + $selected{G} = 'selected'; + } + $checked{a} = $chtxt =~ /animax|atx|disney|kids/ || $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 ) { + 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/ ); + } + } + + $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 {
\n}; + $HTML .= qq {\n}; + $HTML .= qq {ファイル名日時追加\n} if ( $shift eq 'reserve' ); + $HTML .= qq {隔週録画\n} if ( $shift eq 'reserve' ); } sub parse_program { @@ -1666,6 +1883,33 @@ 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"; + ( $rel ) = $abs =~ /^$base_dir\/(.*)$/; + $ptr->( $rel, $abs ); + } + } +} + sub strisjoined { my $str = shift; @@ -1703,8 +1947,8 @@ sub str2readable { my $begin = shift; my $end = shift; - my $dt_begin = &str2datetime( $begin ); - my $dt_end = &str2datetime( $end ); + 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' ); @@ -1729,6 +1973,7 @@ sub sqlgetsuggested { 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' ); @@ -1755,3 +2000,4 @@ sub sqlgetsuggested { return %hash; } + -- 2.11.0