#!/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;
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' );
if ( -e '/etc/rec10.conf' ) {
$cfg->read( '/etc/rec10.conf' );
}
-else {
- $cfg->read( 'config.ini' );
-}
my $sql = $cfg->param( 'db.db' );
$dbh->do( 'SET NAMES utf8' );
}
+
my $HTML;
#print "Content-Type: text/html\n\n";
<html lang="ja">
<head>
<title>Rec10%HTML_TITLE_OPT%</title>
+<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
<meta http-equiv="Content-Script-Type" content="text/javascript">
<meta http-equiv="Content-Style-Type" content="text/css">
-<meta http-equiv="Content-Type" content="text/html; charset=UTF-8">
+<meta name="robots" content="noindex,nofollow,noarchive">
<link rev="made" href="Rea10">
<link rel="alternate" type="application/atom+xml" title= "Rec10 Atom Feed" href="./rectool.pl?mode=atom">
%REFRESH%
%HTML_HEADER%
EOM
+my ( $user, $pass, $auth );
+( $user, $pass ) = eval {
+ $dbh->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 {<div>\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' => '隔日検索',
'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 = (
INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
ORDER BY $order");
- $HTML .= qq {<div style="font-size: 10pt; float: left">\n};
+ $HTML .= qq {<div style="font-size: 80%; float: left">\n};
$HTML .= qq {<form method="get" action="rectool.pl">\n};
$HTML .= qq {<div>\n};
$HTML .= qq {<input type="hidden" name="mode" value="change">\n};
$line->[9] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[9] && $line->[1] eq 'search_everyday' );
$line->[10] = qq {<span style="color: #FF0000">空</span>} if ( !$line->[10] );
}
- elsif ( $line->[1] eq 'reserve_running' ) {
- $type = qq {<span style="color: #FF8C00">$type</span>};
- }
- elsif ( $line->[1] =~ /^reserve/ ) {
- $type = qq {<span style="color: #4169E1">$type</span>};
- }
- elsif ( $line->[1] eq 'convert_b25_ts' ) {
- $type = qq {<span style="color: #BC8F8F">$type</span>};
- }
- elsif ( $line->[1] eq 'convert_b25_ts_running' ) {
- $type = qq {<span style="color: #DC143C">$type</span>};
- }
- elsif ( $line->[1] eq 'convert_ts_mp4' ) {
- $type = qq {<span style="color: #32CD32">$type</span>};
- }
- elsif ( $line->[1] eq 'convert_ts_mp4_running' ) {
- $type = qq {<span style="color: #2E8B57">$type</span>};
- }
else {
- $type = qq {<span style="color: #A0A0A0">$type</span>};
+ my $color = $color{$line->[1]} ? $color{$line->[1]} : $color{'other'};
+ $type = qq {<span style="color: $color">$type</span>};
}
$chname_encoded = $q->url_encode( $line->[4] );
$line->[5] = 'タイトルなし' if ( !$line->[5] );
if ( $ary[0] ne $line->[5] ) {
my $count = $ary[0] =~ s/\Q$line->[5]\E//;
if ( !$count ) {
- $ary[0] = qq {<span style="color: #FF4000">$ary[0]</span>};
+ my $href = qq {<a href="rectool.pl?mode=edit&id=$line->[0]&suggest=auto">自動検索</a>};
+ $ary[0] = qq {<span style="color: #FF4000">$ary[0]■$href■</span>};
}
}
else {
$ary[0] = '説明';
}
- if ( $ary[1] ) {
- $line->[11] = qq {<div style="float: right; cursor: help" title="$ary[1]">$ary[0]</div>};
- }
- else {
- $line->[11] = qq {<span style="float: right">説明なし</span>};
- }
+ $line->[11] = qq {<div style="float: right; cursor: help" title="$ary[1]">$ary[0]</div>};
}
else {
my $href = qq {<a href="rectool.pl?mode=edit&id=$line->[0]&suggest=auto">自動検索</a>};
- $line->[11] = qq {<span style="float: right; color: #FF0000">！$href！</span>};
+ $line->[11] = qq {<span style="float: right; color: #FF0000">■$href■</span>};
}
}
- 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 (
$hr .= qq { background-color: blue; border: none" title="$percent%">};
}
- $line->[5] = qq {<div style="float: left">$line->[5]</div>} if ( $line->[11] );
$line->[5] = qq {<a href="rectool.pl?mode=edit&id=$line->[0]">$line->[5]</a>};
+# $line->[5] = qq {<div style="float: left">$line->[5]</div>} if ( $line->[11] );
$HTML .= qq {<tr align="center">\n};
$HTML .= qq {<td><input type="checkbox" name="id" value="$line->[0]"></td>\n};
$HTML .= qq {<td>$line->[0]</td>\n};
$HTML .= qq {<td>$type</td>\n};
- $HTML .= qq {<td><a href="rectool.pl?mode=program&chname=$chname_encoded">$line->[2]</a></td>\n};
+ $HTML .= qq {<td><a href="rectool.pl?mode=program&chtxt=$line->[2]">$line->[2]</a></td>\n};
$HTML .= qq {<td align="left" style="white-space: normal">$line->[5]$line->[11]</td>\n};
$HTML .= qq {<td>$begin</td>\n<td>$end</td>\n};
$HTML .= qq {<td>$hr$diff</td>\n};
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};
$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' } );
}
my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name;
utf8::encode( $dn );
$HTML .= qq {$date[1]/$date[2]($dn)の予約状況<br>\n};
- $HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&graph=$date" width="820">\n};
+ $HTML .= qq {<object type="image/svg+xml" data="rectool.pl?mode=graph&date=$date" width="820">\n};
$HTML .= qq {SVG Image $date\n</object>\n<br>\n};
$date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d');
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]<br />\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]<br />\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<br />\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' ) {
$HTML .= qq {ID\n<input type="text" name="id" value="$id" size=$len disabled>\n};
$HTML .= qq {タイプ\n<select name="type" onChange="setType();">\n};
foreach my $key ( keys %type ) {
- next if ( $key !~ /^search|^reserve|^convert_b25_ts$|^convert_ts_mp4$|^$type$/ );
+ next if ( $key !~ /^search|^reserve_flexible$|^reserve_fixed$|^convert_b25_ts$|^convert_ts_mp4$|^$type$/ );
$value = $type{$key};
if ( $key eq $type ) {
$HTML .= qq {<option value="$key" selected>$value</option>\n};
$HTML .= qq {</select>\n};
$HTML .= qq {チャンネル\n<select name="chtxt">\n};
$ary_ref = $dbh->selectall_arrayref(
- "SELECT chname, chtxt FROM epg_ch"
+ "SELECT chtxt, chname FROM epg_ch"
);
foreach my $line ( @{$ary_ref} ) {
- if ( $line->[1] eq $chtxt ) {
- $HTML .= qq {<option value="$line->[1]" selected>$line->[0]</option>\n};
+ if ( $line->[0] eq $chtxt ) {
+ $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
}
else {
- $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
+ $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
}
}
$HTML .= qq {</select><br>\n};
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<br>";
+ 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;
+ }
}
&parse_program();
my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
+ $title = $q->param( 'title' ) if ( !$title );
$HTML .= "番組名：$title<br>\nチャンネル：$chname<br>\n放送継続時間：$duration分<br>\n番組内容：$desc<br>\n";
if ( $longdesc ) {
$longdesc =~ s/\\n/<br>\n/gs;
$begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
$end =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/;
$overlap = &get_overlap() >= 2 ? '不可能' :
- qq {<a href="rectool.pl?mode=confirm&mode_sub=reserve&chname=$chname&start=$line->[0]&stop=$line->[1]">可能</a>};
+ qq {<a href="rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$chtxt&start=$line->[0]&stop=$line->[1]">可能</a>};
$HTML .= "開始：$begin\n終了：$end\n録画は$overlap<br>\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 .= "録画予約の詳細設定を行ってください。<br>\n";
$HTML .= qq {<form method="get" action="rectool.pl">\n};
$HTML .= qq {<input type="hidden" name="mode" value="reserve">\n};
$HTML .= qq {<input type="hidden" name="chname" value="$chname">\n};
$HTML .= qq {<input type="hidden" name="start" value="$start">\n};
$HTML .= qq {<input type="hidden" name="stop" value="$stop">\n};
- $HTML .= qq {<select name="opt">\n};
- $HTML .= qq {<option value="L" $selected_l>L ***x*** 1250kbps</option>\n};
- $HTML .= qq {<option value="G" $selected_g>G 1280x720 2500kbps</option>\n};
- $HTML .= qq {<option value="H" $selected_h>H 1280x720 3750kbps</option>\n};
- $HTML .= qq {<option value="F" $selected_f>F 1920x1080 5000kbps</option>\n};
- $HTML .= qq {<option value="S">S 720x480 1250kbps</option>\n};
- $HTML .= qq {</select>\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="v" $checked_v>可変フレームレート\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked_d>二ヶ国語放送\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked_2>2passモード\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked_5>5.1ch放送\n};
- $HTML .= qq {<br>\n};
- $HTML .= qq {<select name="opt">\n};
- $HTML .= qq {<option value="">移動なし</option>\n};
- $HTML .= qq {<option value="R">録画後移動</option>\n};
- $HTML .= qq {<option value="D">解読後移動</option>\n};
- $HTML .= qq {<option value="E">縁故後移動</option>\n};
- $HTML .= qq {</select>\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="N">ファイル名日時追加\n};
- $HTML .= qq {<input type="checkbox" name="every" value="1">隔週録画\n};
+ $HTML .= qq {<input type="hidden" name="title" value="$title">\n} if ( $q->param( 'title' ) );
+ &draw_form_opt( 'reserve' );
$HTML .= qq {<input type="submit" value="予約">\n</form>\n};
}
goto end;
# 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 .= "詳細設定を行ってください。<br>\n";
$HTML .= "タイトル：$title\n<br>\n";
$HTML .= qq {<input type="hidden" name="mode_sub" value="proc">\n};
$HTML .= qq {<input type="hidden" name="type" value="$type">\n};
$HTML .= qq {<input type="hidden" name="title" value="$title">\n};
- $HTML .= qq {<select name="chtxt">\n};
- $ary_ref = $dbh->selectall_arrayref(
- "SELECT chname, chtxt FROM epg_ch"
- );
- foreach my $line ( @{$ary_ref} ) {
- if ( $line->[1] eq $chtxt ) {
- $HTML .= qq {<option value="$line->[1]" selected>$line->[0]</option>\n};
- }
- else {
- $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
- }
- }
- $HTML .= qq {</select>\n};
-
- $HTML .= qq {<select name="opt">\n};
- $HTML .= qq {<option value="L" $selected_l>L ***x*** 1250kbps</option>\n};
- $HTML .= qq {<option value="G" $selected_g>G 1280x720 2500kbps</option>\n};
- $HTML .= qq {<option value="H" $selected_h>H 1280x720 3750kbps</option>\n};
- $HTML .= qq {<option value="F" $selected_f>F 1920x1080 5000kbps</option>\n};
- $HTML .= qq {<option value="S">S 720x480 1250kbps</option>\n};
- $HTML .= qq {</select>\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked_a>アニメ\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked_d>二ヶ国語放送\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked_2>2passモード\n};
- $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked_5>5.1ch放送\n};
+ &draw_form_channel( 'nonone' );
+ &draw_form_opt();
$HTML .= qq {<input type="submit" value="予約">\n</form>\n};
goto end;
}
if ( $mode eq 'reserve' ) {
$HTML .= qq {<div style="float: left">\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;
}
$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";
$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 ) {
utf8::encode( $dn );
$HTML .= qq {--------$date[1]/$date[2]($dn)--------<br>\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 {<a href="rectool.pl?mode=confirm&mode_sub=reserve&chname=$prg->[5]&start=$prg->[2]&stop=$prg->[3]">$prg->[4]</a><br>\n};
+ $HTML .= qq {$prg->[2] } if ( !$ontv );
+ $HTML .= qq {<a href="rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$prg->[1]&start=$prg->[3]&stop=$prg->[4]">$prg->[5]</a><br>\n};
$prev = $date;
}
}
if ( $mode eq 'list' ) {
- require File::Find;
-
$HTML =~ s/%HTML_TITLE_OPT%/ - List/;
+ $HTML .= qq {<div>\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 .= '<pre>'.$log."</pre>\n";
+ goto end;
+ }
if ( !$mode_sub ) {
$HTML .= qq {<a href="rectool.pl?mode=list&mode_sub=new">録画中のみ</a>\n};
$HTML .= qq {<a href="rectool.pl?mode=list&mode_sub=old">録画後のみ</a>\n<br>\n};
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 { = サムネイル<br>\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常<br>\n};
+ $HTML .= $help;
+ $help = qq {<tr style="background-color: #87CEEB"><td rowspan="2">$help\n</td>\n};
+ $help .= qq {<td>$_</td>\n} for ( 1..$exp_count );
+ $help .= qq {<td colspan="2">自動移動</td>\n</tr>\n};
+ $help .= qq {<tr>\n</tr>\n};
+
+ $HTML .= qq {<br>\n○ = 完了 / ● = 書き込み中 / ◆ = ファイルサイズ異常<br>\n};
$HTML .= qq {<table summary="listtable" border=1 cellspacing=0>\n<tr>\n};
$HTML .= qq {<th>タイトル</th>\n};
- $HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count + 1 );
+ $HTML .= qq {<th>$_</th>\n} for ( 1..$exp_count );
$HTML .= qq {<th colspan="2">自動移動</th>\n};
$HTML .= qq {</tr>\n};
- foreach ( sort keys %list ) {
- my $value = $list{$_};
- my @flag = ( 0 ) x $exp_count;
- $HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$_</td>\n};
- foreach ( keys %{$value} ) {
- my $tmp = $_;
- $flag[$exp{$tmp}] = $value->{$_};
+ my $count = 0;
+
+ foreach my $title ( sort keys %list ) {
+ my $value = $list{$title};
+ my @flag = ( 0 ) x ( $exp_count );
+ $HTML .= qq {<tr>\n<td width="600" style="width: 600px; white-space: normal">$title</td>\n};
+ foreach my $exp ( keys %{$value} ) {
+ if ( $exp eq 'log' ) {
+ my $title = $q->url_encode( $title );
+ my $check = qq {<td><a href="rectool.pl?mode=list&mode_sub=log&title=$title">○</a></td>\n};
+
+ $value->{$exp}->{check} = $check;
+ }
+ elsif ( $exp eq 'mkv' ) {
+ my $title = $q->url_encode( $title );
+
+ my $check = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&title=$title">■</a></td>\n};
+ $value->{$exp}->{check} = $check;
+ }
+ $flag[$exp{$exp}] = $value->{$exp};
+ }
+ if ( !$flag[$exp{'mkv'}] ) {
+ $flag[@flag]->{check} = qq {<td colspan="2"><br></td>\n};
+ }
+ else {
+ my $title = $q->url_encode( $title );
+
+ $flag[@flag]->{check} =
+ qq {<td><a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=predict&title=$title">予測</a></td>\n}.
+ qq {<td><a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=exec&title=$title">実行</a></td>\n};
}
foreach ( @flag ) {
my $size = $_->{size};
my $last = $_->{last} || ( $_->{size} eq '0 B' ? '◆' : '○' );
- my $check = $size ? qq {<span title="$size">$last</span>} : '<br>';
- $HTML .= qq {<td>$check</td>\n};
- }
- if ( $flag[$exp{mp4}] ) {
- s/#/＃/g;
- s/ /\+/g;
- my $img = $value->{mp4}->{img};
- $HTML .= qq {<td><a href="rectool.pl?mode=thumb&title=$img">■</a></td>\n};
- my $pre = qq {<a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=predict&title=$_">予測</a>};
- $HTML .= qq {<td>$pre</td>\n};
- my $exe = qq {<a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=exec&title=$_">実行</a>};
- $HTML .= qq {<td>$exe</td>\n};
- }
- else {
- $HTML .= qq {<td><br></td>\n<td colspan="2"><br></td>\n};
+ my $check = $size ? qq {<span title="$size">$last</span>} : '<br>';
+ $HTML .= $_->{check} ? $_->{check} : qq {<td>$check</td>\n};
}
$HTML .= qq {</tr>\n};
+ $HTML .= $help unless ( ++$count % 20 );
}
$HTML .= qq {</table>\n};
sub wanted {
- return if ( !$_ );
- return if ( -d $File::Find::name );
- return if ( $_ eq 'Thumbs.db' );
- return if ( /\.idx/ );
- s/\.temp$//;
+ my $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 .= "$_<br>\n";
}
sub simple_wanted {
- return if ( !$_ );
- return if ( -d $File::Find::name );
- return if ( $_ eq 'Thumbs.db' );
- my ( $size ) = &get_size( $File::Find::name );
- $File::Find::name =~ s/\Q$path\E//;
- push @list, $File::Find::name ."\t\t". $size;
+ 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 ){
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;
}
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 {<a href="$url">予約</a>};
}
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 {<span style="color: $color">$line->[0]</span>} if ( $color );
$HTML .= qq {<tr align="center">\n};
$HTML .= qq {<td>$line->[0]</td>\n};
- $HTML .= qq {<td>$line->[2]</td>\n};
- $HTML .= qq {<td><a href="$url">予約</a></td>\n};
+ $HTML .= qq {<td align="left">$line->[2]</td>\n};
+ $HTML .= qq {<td>$href</td>\n};
$HTML .= qq {</tr>\n};
}
}
+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 {<div>\n};
+ $HTML .= qq {与えられた文字列のうち、番組の放送時刻と思われる文字列を認識します。<br>\n};
+ $HTML .= qq {番組表が取得できない一週間以上先の予約ができます。<br>\n};
+ $HTML .= qq {<form method="post" action="rectool.pl">\n};
+ $HTML .= qq {<div>\n};
+ &draw_form_channel( 'nonone' );
+ $HTML .= qq {<input type="text" name="title" value="$title">\n};
+ $HTML .= qq {<br>\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="recognize">\n};
+ $HTML .= qq {<textarea name="text" cols=40 rows=4>\n$text</textarea>\n};
+ $HTML .= qq {<input type="submit" value="実行">\n</div>\n</form>\n};
+
+ 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 残り:$_<a href="$url">リンク</a> <br>\n};
+ }
+ }
+ }
+}
+
if ( $mode eq 'expert' ) {
+ require List::Compare;
+
my $ary_ref;
$HTML =~ s/%HTML_TITLE_OPT%/ - 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<br>};
+ $HTML .= qq {<form method="get" action="rectool.pl">\n};
+ $HTML .= qq {<div>\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="change">\n};
+ $HTML .= qq {<input type="hidden" name="mode_sub" value="setting">\n};
+ $HTML .= qq {<input type="checkbox" name="jbk" value="1" $ary[0]>自動地引\n};
+ $HTML .= qq {<input type="checkbox" name="bayes" value="1" $ary[1]>自動ベイズ\n};
+ $HTML .= qq {<input type="checkbox" name="del_tmp" value="1" $ary[2]>自動一時ファイル削除\n};
+ $HTML .= qq {自動オプション:<input type="text" name="opt" value="$opt">\n};
+ $HTML .= qq {<input type="submit" value="保存">\n</div>\n</form>\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 {<hr>\n番組表のカテゴリ一覧と内蔵の一覧の合致を確認中...\n};
if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {
my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM in_status" );
$HTML .= qq {<hr>\n地上波録画数：$ary[0]\n衛星波録画数：$ary[1]\n解読数：$ary[2]\n縁故数：$ary[3]\n<br>\n};
- use List::Compare;
$ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" );
my $prev;
$HTML .= "<hr>\n番組表の欠落<br>\n";
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/;
$HTML .= qq {</table>\n};
}
+if ( $mode eq 'log' ) {
+ $HTML =~ s/%HTML_TITLE_OPT%/ - Log/;
+
+ $HTML .= qq {<div>\n};
+ $HTML .= qq {<table summary="reclogtable" border=1 cellspacing=0>\n<tr>\n};
+ $HTML .= qq {<th>ID</th>\n};
+ $HTML .= qq {<th>chtxt</th>\n};
+ $HTML .= qq {<th>title</th>\n};
+ $HTML .= qq {<th>btime</th>\n};
+ $HTML .= qq {<th>etime</th>\n};
+ $HTML .= qq {<th>opt</th>\n};
+ $HTML .= qq {<th>exp</th>\n};
+ $HTML .= qq {<th>longexp</th>\n};
+ $HTML .= qq {<th>category</th>\n};
+ $HTML .= qq {</tr>\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 {<tr>\n};
+ $HTML .= qq {<td>$line->[0]</td>\n<td>$line->[1]</td>\n<td>$line->[2]</td>\n<td>$line->[3]</td>\n};
+ $HTML .= qq {<td>$line->[4]</td>\n<td>$line->[5]</td>\n<td>$line->[6]</td>\n<td>$line->[7]</td>\n};
+ $HTML .= qq {<td>$line->[8]</td>\n};
+ $HTML .= qq {</tr>\n};
+ }
+ $HTML .= qq {</table>\n};
+}
+
if ( $mode eq 'help' ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - Help/;
$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
$HTML .= qq {<div>\n};
- require Data::Dumper;
- require Perl6::Slurp;
$tmp = Perl6::Slurp::slurp( 'config.ini' );
$tmp =~ s/\n/<br>\n/gs;
$HTML .= $tmp;
print $HTTP_HEADER;
print $HTML;
+exit;
sub draw_menu {
$hires = Time::HiRes::time() - $hires;
$last_modified = localtime((stat 'rectool.pl')[9]);
$HTML_HEADER .= qq {<div>\n};
- $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elasped: $hires秒</span>\n};
+ $HTML_HEADER .= qq {<span style="float: right; font-size: 8px">Last-Modified: $last_modified<br>Time-Elapsed: $hires秒</span>\n};
$HTML_HEADER .= qq {<span style="float: left">\n};
$HTML_HEADER .= qq {<a href="rectool.pl">トップ</a>\n};
$HTML_HEADER .= qq {<a href="rectool.pl?mode=schedule">予約確認</a>\n};
$HTML_HEADER .= qq {<a href="rectool.pl?mode=expert">玄人仕様</a>\n};
$HTML_HEADER .= qq {<a href="rectool.pl?mode=proc">復旧支援</a>\n};
$HTML_HEADER .= qq {<a href="rectool.pl?mode=jbk">地引</a>\n};
+ $HTML_HEADER .= qq {<a href="rectool.pl?mode=recognize">文字認識</a>\n};
$HTML_HEADER .= qq {<a href="../rec10web/rec10web.py">新規予約</a>\n};
$HTML_HEADER .= qq {<a href="rectool.pl?mode=edit">新規予約2</a>\n};
$HTML_HEADER .= qq {</span>\n};
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 {<div style="float: left">\n};
$HTML .= qq {<form method="get" action="rectool.pl">\n};
$HTML .= qq {<input type="hidden" name="mode" value="program">\n};
# チャンネル指定
- $HTML .= qq {<select name="chname">\n<option value="" selected>無指定</option>\n};
- $ary_ref = $dbh->selectcol_arrayref(
- "SELECT chname FROM epg_ch"
- );
- foreach my $line ( @{$ary_ref} ) {
- if ( $line eq $chname ) {
- $HTML .= qq {<option value="$line" selected>$line</option>\n};
- }
- else {
- $HTML .= qq {<option value="$line">$line</option>\n};
- }
- }
- $HTML .= qq {</select>\n};
+ &draw_form_channel();
# 日付指定
$HTML .= qq {<select name="date">\n<option value="" selected>無指定</option>\n};
$HTML .= qq {</select>\n};
# キーワード指定
- $HTML .= qq {<input name="key" type="text" value="$key" style="width:200px">\n};
+ $HTML .= qq {<input name="key" type="text" value="$key" style="width:200px" accesskey="s">\n};
# フォーム描画
- $HTML .= qq {<input type="submit" value="更新">\n</div>\n</form>\n};
+ $HTML .= qq {<input type="submit" value="更新" accesskey="r">\n</div>\n</form>\n};
+}
+
+sub draw_form_channel {
+ $HTML .= qq {<select name="chtxt">\n};
+ $HTML .= qq {<option value="" selected>無指定</option>\n} if ( shift ne 'nonone' );
+ $ary_ref = $dbh->selectall_arrayref(
+ "SELECT chtxt, chname FROM epg_ch"
+ );
+ foreach my $line ( @{$ary_ref} ) {
+ if ( $line->[0] eq $chtxt || $line->[1] eq $chname ) {
+ $HTML .= qq {<option value="$line->[0]" selected>$line->[1]</option>\n};
+ }
+ else {
+ $HTML .= qq {<option value="$line->[0]">$line->[1]</option>\n};
+ }
+ }
+ $HTML .= qq {</select>\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 {<select name="opt">\n};
+ $HTML .= qq {<option value="S" $selected{S}>S 720x480 1250kbps</option>\n};
+ $HTML .= qq {<option value="L" $selected{L}>L ***x*** 1250kbps</option>\n};
+ $HTML .= qq {<option value="G" $selected{G}>G 1280x720 2500kbps</option>\n};
+ $HTML .= qq {<option value="H" $selected{H}>H 1280x720 3750kbps</option>\n};
+ $HTML .= qq {<option value="F" $selected{F}>F 1920x1080 5000kbps</option>\n};
+ $HTML .= qq {</select>\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="a" $checked{a}>アニメ\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="l" $checked{l}>速度優先\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="h" $checked{h}>画質優先\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="d" $checked{d}>二ヶ国語放送\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="2" $checked{2}>2passモード\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="5" $checked{5}>5.1ch放送\n};
+ $HTML .= qq {<br>\n};
+ $HTML .= qq {<select name="opt">\n};
+ $HTML .= qq {<option value="">移動なし</option>\n};
+ $HTML .= qq {<option value="R">録画後移動</option>\n};
+ $HTML .= qq {<option value="D">解読後移動</option>\n};
+ $HTML .= qq {<option value="E">縁故後移動</option>\n};
+ $HTML .= qq {</select>\n};
+ $HTML .= qq {<input type="checkbox" name="opt" value="N">ファイル名日時追加\n} if ( $shift eq 'reserve' );
+ $HTML .= qq {<input type="checkbox" name="every" value="1">隔週録画\n} if ( $shift eq 'reserve' );
}
sub parse_program {
}
}
+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;
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' );
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' );
return %hash;
}
+
OSDN Git Service
