#use SVG;
#use KCatch;
use warnings;
+use utf8;
use Algorithm::Diff qw(LCS);
use Archive::Zip;
use CGI;
use Date::Simple;
use DateTime;
use DBI;
+use Encode;
use File::Slurp;
+use List::Compare;
+use List::Util;
use MIME::Base64;
use Sort::Naturally;
+use SVG;
use Time::Piece;
use Time::Seconds;
use Time::HiRes;
use Tie::IxHash;
-#require SVG Time::Simple XML::Atom Encode List::Compare List::Util
-use utf8;
+use XML::Atom::Feed;
+use XML::Atom::Entry;
+use XML::Generator::DBI;
+use XML::SAX::Writer;
+use XML::TreePP;
#%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 ) {
'documentary' => { name => 'ドキュメンタリー・教養' , color => '#0000ff' },
'stage' => { name => '演劇' , color => '#8000ff' },
'hobby' => { name => '趣味・実用' , color => '#ff00ff' },
- 'etc' => { name => 'その他' , color => '#ff0080' },
+ 'welfare' => { name => '福祉' , color => '#ff0080' },
+ 'reserved' => { name => '予備' , color => '#808080' },
+ 'etc' => { name => 'その他' , color => '#808080' },
);
################ 初期化ここまで ################
{
print "Content-Type: image/svg+xml\n\n";
- require SVG;
$date = Date::Simple->new( split /-/, $date );
$graph_bgn = $date->format('%Y-%m-%d');
$graph_end = $date->next->format('%Y-%m-%d');
$svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 14, width => $width, height => 2 );
}
if ( $today ) {
- require Time::Simple;
- my $time = Time::Simple->new();
- my $x = ( $time->hours * 60 + $time->minutes ) * 0.5 + 50;
+ my $time = Time::Piece->localtime;
+ my $x = ( $time->hour * 60 + $time->minute ) * 0.5 + 50;
$svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20,
style => { stroke => 'red', 'fill-opacity' => '1.0' } );
}
################ mode=atom ################
if ( $mode eq 'atom' ) {
- require XML::Atom::Feed;
- require XML::Atom::Entry;
-
my $recording_count = $encoding_count = $jbk_count = 0;
my $ary_ref = $dbh->selectall_arrayref(
"SELECT chtxt, title, btime, etime, opt
$datetime_now = $datetime_now->add( minutes => 60 );
my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' );
+ # 録画後/解読後移動ならば、解読予約にオーバーライドする
+ $sql_type = 'convert_b25_ts' if ( $opt =~ /R|D/ );
+
$dbh->do(
"INSERT INTO timeline ( type, chtxt, title, btime, etime, opt )
VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )"
################ mode=expert ################
if ( $mode eq 'expert' ) {
- require List::Compare;
-
my $ary_ref;
$HTML =~ s/%HTML_TITLE_OPT%/ - Expert/;
goto end;
}
+ if ( $params{ 'dump' } ) {
+ # id、epgXXを除外して出力
+ my $sth = $dbh->prepare(
+ "SELECT type, chtxt, title, btime, etime, deltatime, deltaday, opt, counter
+ FROM timeline"
+ );
+ # my $yaw = XML::Handler::YAWriter->new;
+ my $output;
+ my $wri = XML::SAX::Writer->new( Output => \$output );
+ my $gen = XML::Generator::DBI->new(
+ Handler => $wri,
+ AsAttributes => 1,
+ );
+ $gen->execute($sth);
+ # $HTML .= join "\n", @{$yaw->{Strings}};
+ utf8::encode($output);
+ my $len = length $output;
+ print "Content-Type: text/xml\n";
+ print "Content-Length: $len\n";
+ print "Content-Disposition: attachment; filename=\"rec10-reserve-dump.xml\"\n\n";
+ print $output;
+ exit;
+ }
+
+ if ( $params{ 'restore' } ) {
+ my $fh = $q->upload('upfile');
+ my $xml = read_file( $fh );
+ my $tpp = XML::TreePP->new;
+ my $tree = $tpp->parse( $xml );
+ my @rows = @{ $tree->{database}->{select}->{row} };
+
+ # 高速化のためVALUESを連結
+ # INSERT INTO timeline ( ... ) VALUES ( aa, bb, cc ), ( kk, ll, mm ), ( xx, yy, zz )
+ my @keys = qw/type chtxt title btime etime deltatime deltaday opt counter/;
+ my $keys = join ', ', @keys;
+ my @values;
+
+ foreach my $row ( @rows ) {
+ my $values = join ', ', map { "'".$row->{'-'.$_}."'" } @keys;
+ utf8::decode( $values );
+ push @values, "( $values )";
+ }
+ my $sql = "INSERT INTO timeline ( $keys ) VALUES " . join ', ', @values;
+ $dbh->do( "TRUNCATE TABLE timeline" );
+ $dbh->do( $sql );
+ goto end;
+ }
my @ary = $dbh->selectrow_array(
"SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt
$HTML .= qq {<hr>\nRec10 バージョン：$rec10_version\nrectool バージョン：$rectool_version\n<br>\n};
+ if (0) {
$HTML .= qq {<hr>\n番組表の欠落<br>\n};
$ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" );
foreach my $line ( @{$ary_ref} ) {
$program_old = $program_new;
}
$HTML .= qq {<pre>\n$line->[0]\n$error</pre>\n} if ( $error );
- }
+ }
+ }
+
+
+ $HTML .= qq {<hr>\n予約の保存・復元<br>\n};
+ $HTML .= qq {<form action="rectool.pl" method="post" enctype="multipart/form-data">\n};
+ $HTML .= qq {<div>\n};
+ $HTML .= qq {<input type="hidden" name="mode" value="expert">\n};
+ $HTML .= qq {<input type="submit" name="dump" value="保存">\n};
+ $HTML .= qq {<input type="file" name="upfile">\n};
+ $HTML .= qq {<input type="submit" name="restore" value="復元">\n};
+ $HTML .= qq {</div>\n};
+ $HTML .= qq {</form>\n};
$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 " );
+ ORDER BY chtxt " );
$HTML .= qq {<hr>\n番組表の更新状況<br>\n};
$HTML .= qq {<table summary="channeltable" border=1 cellspacing=0>\n<tr>\n};
$HTML .= qq {<th>チャンネル名</th>\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};
$HTML .= qq {<input type="hidden" name="mode_sub" value="reget">\n};
$HTML .= qq {<select name="bctype">\n};
$ary_ref = $dbh->selectall_arrayref(
- "SELECT chname, bctype
+ "SELECT DISTINCT bctype
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->[0]">$line->[0]</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::Concise;
$tmp = read_file( '/etc/rec10.conf' );
$tmp =~ s/\n/<br>\n/gs;
$HTML .= $tmp;
}
sub get_overlap {
- require List::Util;
-
my $ary_ref = $dbh->selectall_arrayref(
"SELECT btime, etime, title
FROM timeline
OSDN Git Service
