use CGI;
use CGI::Carp qw( fatalsToBrowser warningsToBrowser );
use Config::Simple;
-use Data::Dumper;
+use Data::Dumper::Concise;
use Date::Simple;
use DateTime;
use DBI;
+use File::Slurp;
use MIME::Base64;
-use Perl6::Slurp;
use Sort::Naturally;
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
+#require SVG Time::Simple XML::Atom Encode List::Compare List::Util
use utf8;
#%DB::packages = ( 'main' => 1 );
################ バージョン定義 ################
-my $rectool_version = 101;
+my $rectool_version = 102;
################ 初期化ここから ################
my $ary_ref = $dbh->selectall_arrayref(
"SELECT chtxt, chname, ch, bctype FROM epg_ch
- WHERE visible = 1"
+ WHERE visible = 1
+ AND chname != ''
+ ORDER BY chtxt"
);
%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: 地上波
+# bc: BS、CS
+my @te_ary = grep $_->[0]=~ /^\d/, @{$ary_ref};
+my @bc_ary = grep $_->[0]!~ /^\d/, @{$ary_ref};
# teの操作(まとめる)
foreach my $line ( @te_ary ) {
$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>
+ <link rel="stylesheet" type="text/css" href="http://cdn.sencha.io/ext-3.4.0/resources/css/ext-all.css" />
+ <script type="text/javascript" src="http://cdn.sencha.io/ext-3.4.0/adapter/ext/ext-base.js"></script>
+ <script type="text/javascript" src="http://cdn.sencha.io/ext-3.4.0/ext-all.js"></script>
<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"),
+ autoLoad: "rectool.pl?mode=list&mode_sub=ffmpeg&path=" + Ext.Element(elRef).getAttribute("path") +
+ "&pathtype=" + Ext.Element(elRef).getAttribute("pathtype"),
});
win.show();
}, null, {stopEvent:true});
var tooltip = new Ext.ToolTip({
target: elem,
width: 400,
- autoLoad: {url: "rectool.pl?mode=list&mode_sub=ffmpeg&path=" + elem.getAttribute("path")},
+ autoLoad: {url: "rectool.pl?mode=list&mode_sub=ffmpeg&path=" + elem.getAttribute("path")},
autoHide: false,
closable: true,
draggable: true,
$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' );
+ my $recording = $cfg->param( 'path.recpath' );
+ my $movedest = $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" );
+ my $log = read_file( "$recording/$title.log" ) if ( -e "$recording/$title.log" );
utf8::decode( $log );
$HTML .= '<pre>'.$log."</pre>\n";
goto end;
}
if ( $mode_sub eq 'ffmpeg' ) {
my $path = $params{ 'path' };
+ my $pathtype = $params{ 'pathtype' };
+ my $pathdir;
+ $pathdir = $recording if ( $pathtype eq 'ing');
+ $pathdir = $recorded if ( $pathtype eq 'ed' );
+ $pathdir = $movedest if ( $pathtype eq 'dst');
# mediainfo (not working)
# ffprobe
- my $ffmpeg = `ffmpeg -i "$path" 2>&1`;
+ # FIXME: sanitize
+ my $ffmpeg = `ffmpeg -i "$pathdir/$path" 2>&1` if ( -f "$pathdir/$path" );
utf8::decode($ffmpeg);
$ffmpeg = join "<br>\n", grep /Duration|Stream/, split /\n/, $ffmpeg;
$HTML = $ffmpeg;
}
if ( !$mode_sub || $mode_sub eq 'old' ) {
$HTML .= "録画後のファイル一覧<br>\n";
- &simple_list( $ts_movepath );
+ &simple_list( $movedest );
&simple_list( $recorded );
}
# ○などの代わりにサイズを表示
# $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};
+ my $extra = qq {<td><span class="ffmpeg" path="$title.mp4" pathtype="ing">$size</span></td>\n};
$value->{$exp}->{extra} = $extra;
}
elsif ( $exp eq 'mkv' ) {
}
sub simple_list {
- require Encode;
-
local $path = shift;
local @list = ();
&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 = nsort @list;
foreach ( @list ) {
$HTML .= "$_<br>\n";
my $abs = shift;
my ( $size ) = &get_size( $abs );
- $rel = qq {<span class="ffmpeg" path="$abs">$rel</span>};
- push @list, $rel ."\t".$result."\t". $size;
+ $rel = qq {<span class="ffmpeg" path="$rel" pathtype="ed">$rel</span>};
+ push @list, $rel ."\t\t". $size;
}
}
$ary_ref = $dbh->selectall_arrayref(
- "SELECT chname, chtxt, bctype, ch, csch, updatetime, status, visible
+ "SELECT chname, chtxt, bctype, ch, csch, tsid, updatetime, status, visible
FROM epg_ch
ORDER BY bctype " );
$HTML .= qq {<hr>\n番組表の更新状況<br>\n};
$HTML .= qq {<th>bctype</th>\n};
$HTML .= qq {<th>ch</th>\n};
$HTML .= qq {<th>csch</th>\n};
+ $HTML .= qq {<th>tsid</th>\n};
$HTML .= qq {<th>最終更新時刻</th>\n};
$HTML .= qq {<th>状態</th>\n};
$HTML .= qq {<th>表示</th>\n};
$HTML .= qq {<tr>\n};
$HTML .= qq {<td>$status->[0]</td>\n<td>$status->[1]</td>\n<td>$status->[2]</td>\n<td>$status->[3]</td>\n};
$HTML .= qq {<td>$status->[4]</td>\n<td>$status->[5]</td>\n<td>$status->[6]</td>\n<td>$status->[7]</td>\n};
+ $HTML .= qq {<td>$status->[8]</td>\n};
$HTML .= qq {</tr>\n};
}
$HTML .= qq {</table>\n};
FROM epg_ch WHERE bctype NOT LIKE '_s%' "
);
foreach my $line ( @{$ary_ref} ) {
- $HTML .= qq {<option value="$line->[1]">$line->[0]</option>\n};
+ $HTML .= qq {<option value="$line->[1]">$line->[1]</option>\n};
}
$HTML .= qq {<option value="bs">BS</option>\n};
$HTML .= qq {<option value="cs1">CS1</option>\n};
$HTML =~ s|%REFRESH%|<meta http-equiv="refresh" content="300">|;
$HTML .= qq {<div>\n};
- require Data::Dumper;
- $tmp = Perl6::Slurp::slurp( 'config.ini' );
+ require Data::Dumper::Concise;
+ $tmp = read_file( '/etc/rec10.conf' );
$tmp =~ s/\n/<br>\n/gs;
$HTML .= $tmp;
$bayesid = $params{ 'bayesid' };
$id = $params{ 'id' };
+ # chtxt と chname を相互に補完
if ( $chname ) {
$chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname'");
}
elsif ( $chtxt ) {
$chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE chtxt = '$chtxt'")
}
+
+ # EPGから番組の情報を取得
( $title, $desc, $longdesc, $category ) = $dbh->selectrow_array(
"SELECT title, exp, longexp, category
FROM epg_timeline
"SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter
FROM timeline WHERE id = '$id' "
);
+ &chtxt_format();
( $chname, $bctype ) = $dbh->selectrow_array(
- "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' "
+ "SELECT chname, bctype FROM epg_ch WHERE chtxt LIKE '$chtxt_sql' "
);
$start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' );
$stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' );
"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/ ) {
- ( $chtxt_0 = $chtxt ) =~ s/(\d+)_.*/$1_0/;
- ( $chtxt_sql = $chtxt ) =~ s/_0/_%/;
- $bctype_sql = 'te%';
- }
+ # set $chtxt_0, $chtxt_sql, $bctype_sql
+ &chtxt_format();
#( $chtxt_no0 ) = $chtxt =~ /(\d+)_/;
@start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
@stop = $stop =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/;
}
sub sqlgetsuggested {
- require Encode;
- require Text::Ngram;
-
my ( $btime, $etime ) = @_;
$deltatime = 3 if ( !$deltatime );
#die Dumper $ary_ref;
my %hash;
- my $hash_r = Text::Ngram::ngram_counts( $title, 2 ); # bi-gram
+ my $hash_r = ngram_counts( $title, 2 ); # bi-gram
foreach my $program ( @{$ary_ref} ) {
- my $hash_k = Text::Ngram::ngram_counts( $program->[2], 2 );
+ no warnings;
+ my $hash_k = ngram_counts( $program->[2], 2 );
my $point;
map $point += $hash_k->{$_}, keys %{$hash_r};
push @{$hash{$point}}, $program if ( $point );
return %hash;
}
+sub ngram_counts {
+ my $str = shift;
+ my $klen = shift;
+ my $slen = length($str);
+
+ my $href;
+ for (my $i=0; $i < $slen-$klen+1; $i++){
+ $href->{substr($str, $i, $klen)}++;
+ }
+ return $href;
+}
+
+sub chtxt_format {
+ ( $chtxt_0 = $chtxt ) =~ s/(\d+)_\d+/$1_0/;
+ ( $chtxt_sql = $chtxt ) =~ s/(\d+)_\d+/$1_%/;
+ if ( $bctype =~ /bs|cs/ ) {
+ $bctype_sql = '_s%';
+ }
+ elsif ( $bctype =~ /te/ ) {
+ $bctype_sql = 'te%';
+ }
+}
+