#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 Algorithm::Diff qw(LCS);
+use Archive::Zip;
use CGI;
-use MIME::Base64;
+use CGI::Carp qw( fatalsToBrowser warningsToBrowser );
use Config::Simple;
-use Time::HiRes;
use Data::Dumper;
-use Tie::IxHash;
+use Date::Simple;
+use DateTime;
+use DBI;
+use MIME::Base64;
use Perl6::Slurp;
use Sort::Naturally;
-use Algorithm::Diff qw(LCS);
+use Time::Piece;
+use Time::Seconds;
+use Time::HiRes;
+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 = 100;
+my $rectool_version = 101;
################ 初期化ここから ################
# NHK BS 1/2/hiをBS/CSから除外(101-103) - by 2011/04
# te: 地上波、BSのNHK以外
# bc: BSのNHK、CS
-my @te_ary = grep $_->[0]=~ /^\d|BS_(?!10[1-3])/, @{$ary_ref};
-my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!10[1-3])/, @{$ary_ref};
+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 ) {
$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' },
);
-
################ 初期化ここまで ################
$day = $date->day;
$today = $date eq Date::Simple->today() ? 1 : 0;
- $tuner{terrestrial} = 2; #$cfg->param( 'env.te_max' );
- $tuner{satellite} = 2; #$cfg->param( 'env.bscs_max' );
+ $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,
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;
$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, title, timeline.chtxt, btime, etime, opt FROM timeline
- INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
- WHERE epg_ch.bctype LIKE '$bctype'
- AND type IN $type_user_made
- 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"
- , {Slice=>{}}
- );
- foreach my $line ( @{ $ary_ref } ) {
+ 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;
$begin = $line->{btime};
$end = $line->{etime};
- my $ary = $dbh->selectall_arrayref(
- "SELECT id, type, timeline.chtxt, title, btime, etime, opt FROM timeline
- INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt
- WHERE epg_ch.bctype LIKE '$bctype'
- AND type IN $type_user_made
- AND NOT
- (
- ( etime <= '$begin' )
- OR
- ( btime >= '$end' )
- )
- ORDER BY id"
- , {Slice=>{}}
- );
- my @ary = @{$ary};
- for ( 0..$tuner - 1 ) {
- my $f = 1;
- my $i = $_;
- for ( 'chtxt', 'btime', 'etime' ) {
- $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} );
- }
- if ( $f ) {
- $slot = $i;
- }
+ 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->{opt} =~ /a/ );
}
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->{id}",
-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 .= qq {<div style="float: left">\n};
# $base64 = encode_base64( $svg->xmlify );
# $HTML .= qq {<object data="data:image/svg+xml;base64,$base64">\n</object>\n};
- $HTML .= qq {äº\88ç´\84ç\8a¶æ³\81ä¸\80覧ã\81§ã\81\99ã\80\82T1,T2ã\81¯å\9c°ä¸\8aæ³¢ã\80\81S1,S2ã\81¯BS/CSã\80\81赤ã\81¯ã\82¢ã\83\8bã\83¡ã\80\81ç·\91ã\81¯HDã\80\81é\9d\92ã\81¯ã\82¤ã\83³ã\82¿ã\83¼ã\83¬ã\83¼ã\82¹ã\82\92示ã\81\97ã\81¦ã\81\84ã\81¾ã\81\99ã\80\82<br>\n};
+ $HTML .= qq {予約状況一覧です。T1,T2は地上波、S1,S2はBS/CSを示しています。<br>\n};
$HTML .= qq {SVGが利用可能なブラウザでご覧ください。<br>\n};
+ $HTML .= qq {色とジャンルの対応\n};
+ map {
+ $HTML .= qq {<span style="background: $_->{color}; top: 10px; left: 250px;">$_->{name}</span>\n};
+ } values %category;
+ $HTML .= qq {<br>\n};
$ary_ref = $dbh->selectcol_arrayref(
"SELECT DISTINCT DATE( btime )
&parse_program();
my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes;
- $HTML .= "番組名:$title<br>\nチャンネル:$chname<br>\n放送継続時間:$duration 分<br>\n番組内容:$desc<br>\n";
+ $HTML .= "番組名:$title<br>\nチャンネル:$chname<br>\n放送継続時間:$duration 分<br>\n番組内容:$desc<br>\nジャンル:$category<br>\n";
if ( $longdesc ) {
$longdesc =~ s/\\n/<br>\n/gs;
$HTML .= "番組内容(長):$longdesc<br>\n";
if ( $category_sel ) {
# 一時的
# $category_tmp = $category{$category_sel} . $category_sel;
- my $category = "AND category = '$category{$category_sel}'";
+ my $category = "AND category = '$category{$category_sel}->{name}'";
$sql =~ s/%CATEGORY%/$category/;
}
if ( $key ) {
$HTML =~ s/%HTML_TITLE_OPT%/ - List/;
$HTML .= qq {<div>\n};
+ $script = <<EOM;
+ <link rel="stylesheet" type="text/css" href="http://extjs-public.googlecode.com/svn/tags/extjs-3.4.0/release/resources/css/ext-all.css" />
+ <script type="text/javascript" src="http://extjs-public.googlecode.com/svn/tags/extjs-3.4.0/release/adapter/ext/ext-base.js"></script>
+ <script type="text/javascript" src="http://extjs-public.googlecode.com/svn/tags/extjs-3.4.0/release/ext-all.js"></script>
+ <style type="text/css">
+ .x-tip-body { font-size: 16px; }
+ </style>
+ <script>
+ Ext.onReady(function() {
+ Ext.select('.ffmpeg').on('contextmenu', function(eventObj, elRef) {
+ var win = new Ext.Window({
+ title: 'FFmpeg info',
+ //autoShow: true,
+ autoLoad: "rectool.pl?mode=list&mode_sub=ffmpeg&path=" + Ext.Element(elRef).getAttribute("path"),
+ });
+ win.show();
+ }, null, {stopEvent:true});
+/*
+ Ext.select( '.ffmpeg' , true ).each(function (elem) {
+ // elem.dom.textContent
+ var tooltip = new Ext.ToolTip({
+ target: elem,
+ width: 400,
+ autoLoad: {url: "rectool.pl?mode=list&mode_sub=ffmpeg&path=" + elem.getAttribute("path")},
+ autoHide: false,
+ closable: true,
+ draggable: true,
+ title: 'FFmpeg info',
+ });
+ });
+*/
+ });
+ </script>
+EOM
+ $script =~ s/^\t{2}//gm;
+ $HTML =~ s/%SCRIPT%/$script/;
+
my $recording = $cfg->param( 'path.recpath' );
my $ts_movepath = $cfg->param( 'path.ts_movepath' );
my $recorded = $cfg->param( 'path.recorded' );
$HTML .= '<pre>'.$log."</pre>\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<hr>\n";
+ }
+
+ utf8::decode( $logzip );
+ $HTML .= '<pre>'.$logzip."</pre>\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 "<br>\n", grep /Duration|Stream/, split /\n/, $ffmpeg;
+ $HTML = $ffmpeg;
+ 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};
$HTML .= $help;
$help = qq {<tr style="background-color: #87CEEB"><td>$help\n</td>\n};
$help .= qq {<td>$_</td>\n} for ( 1..$exp_count );
- $help .= qq {<td colspan="2">自動移動</td>\n</tr>\n};
- $help .= qq {<tr>\n</tr>\n};
$HTML .= qq {<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 );
- $HTML .= qq {<th colspan="2">自動移動</th>\n};
$HTML .= qq {</tr>\n};
my $count = 0;
$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->escape( $title );
- my $check = qq {<td><a href="rectool.pl?mode=list&mode_sub=log&title=$title">○</a></td>\n};
+ my $extra = qq {<td><a href="rectool.pl?mode=list&mode_sub=log&title=$title">○</a></td>\n};
- $value->{$exp}->{check} = $check;
+ $value->{$exp}->{extra} = $extra;
+ }
+ elsif ( $exp eq 'log.zip' ) {
+ # ZIPログへのリンクを追加
+ my $title = $q->escape( $title );
+ my $extra = qq {<td><a href="rectool.pl?mode=list&mode_sub=logzip&title=$title">○</a></td>\n};
+
+ $value->{$exp}->{extra} = $extra;
+ }
+ elsif ( $exp eq 'mp4' ) {
+ # ○などの代わりにサイズを表示
+ # $value->{$exp}->{style} = $value->{$exp}->{size};
+ my $size = $value->{$exp}->{size};
+ my $extra = qq {<td><span class="ffmpeg" path="$path/$title.mp4">$size</span></td>\n};
+ $value->{$exp}->{extra} = $extra;
}
elsif ( $exp eq 'mkv' ) {
+ # サムネイルへのリンクを追加
my $title = $q->escape( $title );
- my $check = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&title=$title">■</a></td>\n};
- $value->{$exp}->{check} = $check;
+ my $extra = qq {<td><a title="$value->{$exp}->{size}" href="rectool.pl?mode=thumb&title=$title">■</a></td>\n};
+ $value->{$exp}->{extra} = $extra;
}
$flag[$exp{$exp}] = $value->{$exp};
}
- if ( !$flag[$exp{'mkv'}] ) {
- $flag[@flag]->{check} = qq {<td colspan="2"><br></td>\n};
- }
- else {
- my $title = $q->escape( $title );
-
- $flag[@flag]->{check} =
- qq {<td><a href="rectool.pl?mode=change&mode_sub=move&mode_sub2=predict&title=$title">予測</a></td>\n}.
- 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 .= $_->{check} ? $_->{check} : qq {<td>$check</td>\n};
+ my $size = $_->{size};
+ my $style = $_->{style};
+ my $span = $size ? qq {<span title="$size">$style</span>} : '<br>';
+ $HTML .= $_->{extra} || qq {<td>$span</td>\n};
}
$HTML .= qq {</tr>\n};
$HTML .= $help unless ( ++$count % 20 );
$rel =~ s/\.temp$//;
my $regexp = join '|', keys %exp;
my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/;
- my ( $size, $last ) = &get_size( $abs );
+ my ( $size, $style ) = &get_size( $abs );
$rel =~ s/\.temp$//;
if ( !$title ) {
$title = '_error_exp_'.$rel;
$title = 'Base16_'.$tmp;
}
}
- $list{$title}->{$exp} = { 'last' => $last, 'size' => $size };
+ $list{$title}->{$exp} = { 'style' => $style, 'size' => $size };
}
}
my $abs = shift;
my ( $size ) = &get_size( $abs );
- push @list, $rel ."\t\t". $size;
+ $rel = qq {<span class="ffmpeg" path="$abs">$rel</span>};
+ push @list, $rel ."\t".$result."\t". $size;
}
}
$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 );
}
}
$HTML .= qq {<th>キーワード</th>\n};
$HTML .= qq {<th>自動録画</th>\n};
$HTML .= qq {<th>切り替え</th>\n};
+ $HTML .= qq {<th>録画オプション</th>\n};
$HTML .= qq {<th>削除</th>\n};
$HTML .= qq {</tr>\n};
my $ary_ref = $dbh->selectall_arrayref(
- "SELECT id, keyword, auto
+ "SELECT id, keyword, auto, opt
FROM in_auto_jbk_key
ORDER BY id " );
$HTML .= qq {<td>$line->[1]</td>\n};
$HTML .= qq {<td>$auto</td>\n};
$HTML .= qq {<td><a href="$oppourl">$oppo</a></td>\n};
+ $HTML .= qq {<td>$line->[3]</a></td>\n};
$HTML .= qq {<td><a href="$delurl">削除</a></td>\n};
$HTML .= qq {</tr>\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 "
+ INNER JOIN epg_ch ON auto_timeline_keyword.chtxt = epg_ch.chtxt
+ ORDER BY btime"
, {Slice=>{}} );
foreach my $line ( @{ $ary_ref } ) {
$ary_ref = $dbh->selectcol_arrayref(
"SELECT DISTINCT category FROM epg_timeline"
);
- my @category = sort values %category;
+ my @category = map {$_->{name}} sort values %category;
if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) {
$HTML .= qq {一致しません<br>\n};
$HTML .= qq {番組表:@{$ary_ref}<br>\n内蔵:@category<br>\n};
$category_sel = $params{ 'category' };
foreach my $category ( keys %category ) {
if ( $category eq $category_sel ) {
- $HTML .= qq {<option value="$category" selected>$category{$category}</option>\n};
+ $HTML .= qq {<option value="$category" selected>$category{$category}->{name}</option>\n};
}
else {
- $HTML .= qq {<option value="$category">$category{$category}</option>\n};
+ $HTML .= qq {<option value="$category">$category{$category}->{name}</option>\n};
}
}
$HTML .= qq {</select>\n};
$HTML .= qq {<option value="" $selected{s}>モバイル向け</option>\n};
$HTML .= qq {<option value="1" $selected{e}>QVGA</option>\n};
$HTML .= qq {<option value="2" $selected{r}>WVGA</option>\n};
+ $HTML .= qq {<option value="B" $selected{B}>Blu-ray向け</option>\n};
$HTML .= qq {</select>\n};
$HTML .= qq {<input type="checkbox" name="opt" value="a" $checked{a}>24fps(主にアニメ)\n};
return %hash;
}
+