--- /dev/null
+#!/usr/bin/perl
+use strict;
+use KCatch;
+use Config::Simple;
+use DBI;
+use CGI::Minimal;
+use SVG;
+use Time::Piece;
+use Encode;
+use Text::Ngram;
+use utf8;
+our $svg="";
+our $dbh;
+my $cgi=CGI::Minimal->new;
+my $nHTML="";
+
+my $cfg = new Config::Simple;
+if ( -e '/etc/rec10.conf' ) {
+ $cfg->read( '/etc/rec10.conf' );
+}
+my $sql = $cfg->param( 'db.db' );
+if ( $sql eq 'MySQL') {
+ my $name = $cfg->param( 'db.mysql_dbname' );
+ my $host = $cfg->param( 'db.mysql_host' );
+ my $port = $cfg->param( 'db.mysql_port' );
+ my $user = $cfg->param( 'db.mysql_user' );
+ my $pass = $cfg->param( 'db.mysql_passwd' );
+ $dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {
+ AutoCommit => 1,
+ RaiseError => 1,
+ });
+ $dbh->do( 'SET NAMES utf8' );
+}
+my $btimenow=localtime;
+my $etimenow=$btimenow+12*60*60;
+if ($cgi->param('mode') eq "graph"){
+ $nHTML ="";
+ $nHTML = qq {Content-type:image/svg+xml\n\n};
+ my $date = Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
+ my $date2 = Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
+ my $ddate = $date2-$date;
+ my $dtime = $ddate->hours;
+ if ($dtime<1){
+ $dtime=1;
+ }
+ $nHTML .= chtimesvg($cgi->param('chtxt'),$date,$dtime);
+}elsif ($cgi->param('mode') eq "timegraph"){
+ $nHTML ="";
+ $nHTML = qq {Content-type:image/svg+xml\n\n};
+ my $date = Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
+ my $date2 = Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
+ my $ddate = $date2-$date;
+ my $dtime = $ddate->hours;
+ if ($dtime<1){
+ $dtime=1;
+ }
+ $nHTML .= timesvg($date,$dtime);
+}elsif ($cgi->param('mode') eq "table"){
+ $nHTML ="";
+ $nHTML = qq {Content-type:application/xhtml+xml\n\n};
+ my $date = Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
+ my $date2 = Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
+ my $ddate = $date2-$date;
+ my $dtime = $ddate->hours;
+ if ($dtime<1){
+ $dtime=1;
+ }
+ $nHTML .= timesvg($date,$dtime);
+}else{
+ if ($cgi->param('btime')ne ""){
+ $btimenow=Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
+ }
+ if ($cgi->param('etime')ne ""){
+ $etimenow=Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
+ }
+ my $ch1=$cgi->param('ch1');
+ my $ch2=$cgi->param('ch2');
+ my $ch3=$cgi->param('ch3');
+ my $btxt=$btimenow->strftime('%Y-%m-%d_%H-00-00');
+ my $etxt=$etimenow->strftime('%Y-%m-%d_%H-00-00');
+ my $btxtnew2=$etimenow;
+ my $etxtnew2=$etimenow+18*60*60;
+ my $hdate=localtime;
+ $hdate=$hdate+1*60*60;
+ my $btxtnew1;
+ my $etxtnew1;
+ if ($btimenow<$hdate){
+ $btxtnew1=$btimenow;
+ $etxtnew1=$etimenow;
+ }else{
+ $btxtnew1=$btimenow-18*60*60;
+ $etxtnew1=$btimenow;
+ }
+ my @clist=@{db_select_chlist()};
+ my $chtxtlist ="";
+ if ($ch1 eq ""){
+ $ch1=$clist[0][0];
+ }
+ if ($ch2 eq ""){
+ $ch2=$clist[1][0];
+ }
+ if ($ch3 eq ""){
+ $ch3=$clist[2][0];
+ }
+ my $blink="rec10webg2.pl?ch1=$ch1&ch2=$ch2&ch3=$ch3&btime=".$btxtnew1->strftime('%Y-%m-%d_%H-%M-%S')."&etime=".$etxtnew1->strftime('%Y-%m-%d_%H-%M-%S');
+ my $alink="rec10webg2.pl?ch1=$ch1&ch2=$ch2&ch3=$ch3&btime=".$btxtnew2->strftime('%Y-%m-%d_%H-%M-%S')."&etime=".$etxtnew2->strftime('%Y-%m-%d_%H-%M-%S');
+ foreach my $cht (@clist){
+ my @cht2=@{$cht};
+ my $chn=$cht2[1];
+ utf8::decode($chn);
+ $chtxtlist=$chtxtlist."<option value=\"$cht2[0]\">$chn</option>\n";
+ }
+ my $chtxtlist1 = $chtxtlist;
+ my $chtxtlist2 = $chtxtlist;
+ my $chtxtlist3 = $chtxtlist;
+ $chtxtlist1 =~ s/$ch1"/$ch1" selected="selected"/;
+ $chtxtlist2 =~ s/$ch2"/$ch2" selected="selected"/;
+ $chtxtlist3 =~ s/$ch3"/$ch3" selected="selected"/;
+ $nHTML .= qq {Content-type:application/xhtml+xml\n\n};
+ $nHTML .= qq {<?xml version="1.0" encoding="UTF-8"?>\n};
+ $nHTML .= qq {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"\n"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">\n};
+ $nHTML .= qq {<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja" lang="ja">\n};
+ $nHTML .= qq {<head>\n};
+ $nHTML .= qq {<title>Rec10WEB G2 番組表 ver alpha 2010-03-15};
+ $nHTML .= qq {</title>\n};
+ $nHTML .= qq {</head>\n};
+ $nHTML .= qq {<body>\n};
+ $nHTML .= qq {<form action="rec10webg2.pl">\n};
+ $nHTML .= qq {<p>Rec10WEB G2 alpha</p>\n};
+ $nHTML .= qq {<p>Rec10 番組表</p>\n};
+ $nHTML .= qq {<p style="width:100%;height:10%;buttom:2%;position:relative;">};
+ $nHTML .= qq {<select size="1" name="ch1" style="left:3%;width:30%;height:100%;position:relative;">\n};
+ $nHTML .= $chtxtlist1;
+ $nHTML .= qq {</select>\n};
+ $nHTML .= qq {<select size="1" name="ch2" style="left:3%;width:30%;height:100%;position:relative;">\n};
+ $nHTML .= $chtxtlist2;
+ $nHTML .= qq {</select>\n};
+ $nHTML .= qq {<select size="1" name="ch3" style="left:3%;width:30%;height:100%;position:relative;">\n};
+ $nHTML .= $chtxtlist3;
+ $nHTML .= qq {</select>\n};
+ $nHTML .= qq {<input type="submit" name="submit" value="表示" style="left:3%;width:3%;position:relative;"/>\n};
+ $nHTML .= qq {</p>\n};
+ $nHTML .= qq {<div style="width:100%;height:82%;bottom:3%;position:fixed;">\n};
+ $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=timegraph&btime=$btxt&etime=$etxt" style="width:3%;height:100%;">\n};
+ $nHTML .= qq {SVG Timeline\n};
+ $nHTML .= qq {</object>\n};
+ $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=graph&chtxt=$ch1&btime=$btxt&etime=$etxt" style="width:30%;height:100%;">\n};
+ $nHTML .= qq {SVG Timeline\n};
+ $nHTML .= qq {</object>\n};
+ $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=graph&chtxt=$ch2&btime=$btxt&etime=$etxt" style="width:30%;height:100%;">\n};
+ $nHTML .= qq {SVG Timeline\n};
+ $nHTML .= qq {</object>\n};
+ $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=graph&chtxt=$ch3&btime=$btxt&etime=$etxt" style="width:30%;height:100%;">\n};
+ $nHTML .= qq {SVG Timeline\n};
+ $nHTML .= qq {</object>\n};
+ $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=timegraph&btime=$btxt&etime=$etxt" style="width:3%;height:100%;">\n};
+ $nHTML .= qq {SVG Timeline\n};
+ $nHTML .= qq {</object>\n};
+ $nHTML .= qq {</div>\n};
+ $nHTML .= qq {<p style="bottom:1%;position:fixed;">\n};
+ $nHTML .= qq {<a href="$blink" style="left:0%;position:fixed;">前へ</a>\n};
+ $nHTML .= qq {<a href="$alink" style="right:3%;position:fixed;">次へ</a>\n};
+ $nHTML .= qq {</p>\n};
+ $nHTML .= qq {</form>\n};
+ $nHTML .= qq {</body>\n};
+ $nHTML .= qq {</html>\n};
+}
+print encode('utf-8',$nHTML);
+sub db_select_auto_bayes_timeline{#chtxt,btime,etime
+ my $ary_db = $dbh->selectall_arrayref(
+ "SELECT chtxt,title, btime, etime, point FROM auto_timeline_bayes"
+ ."WHERE btime >= \"".$_[1]."\" "
+ ."AND "
+ ."etime <= \"".$_[2]."\""
+ ."AND "
+ ."chtxt = \"".$_[0]."\""
+ );
+ return $ary_db;
+}
+sub db_select_auto_jbk_timeline{#chtxt,btime,etime
+ my $ary_db = $dbh->selectall_arrayref(
+ "SELECT chtxt,title, btime, etime, point FROM auto_timeline_keyword"
+ ."WHERE btime >= \"".$_[1]."\" "
+ ."AND "
+ ."etime <= \"".$_[2]."\""
+ ."AND "
+ ."chtxt = \"".$_[0]."\""
+ );
+ return $ary_db;
+}
+sub db_select_timeline{
+ my $ary_db = $dbh->selectall_arrayref(
+ "SELECT type, chtxt, title, btime, etime, deltatime ,deltaday ,opt FROM timeline"
+ );
+ return $ary_db;
+}
+sub db_select_chtxt_btime_etime_timeline{#chtxt,btime,etime
+ my $ary_db = $dbh->selectall_arrayref(
+ "SELECT type, chtxt, title, btime, etime FROM timeline"
+ ."WHERE btime >= \"".$_[1]."\" "
+ ." AND "
+ ."etime <= \"".$_[2]."\""
+ ."AND "
+ ."chtxt = \"".$_[0]."\""
+ );
+ return $ary_db;
+}
+sub db_select_chlist{
+ my $dbe="SELECT chtxt,chname FROM epg_ch";
+ my $ary_db = $dbh->selectall_arrayref($dbe);
+ return $ary_db;
+}
+sub db_select_epg_ch{#chtxt#btime#etime
+ my $dbe="SELECT epg_ch.chtxt,title,start,stop,exp,longexp,category FROM epg_timeline "
+ ."INNER JOIN epg_ch "
+ ."WHERE epg_ch.ontv=epg_timeline.channel "
+ ."AND "
+ ."start >= \"".$_[1]."\" "
+ ."AND "
+ ."stop <= \"".$_[2]."\" "
+ ."AND "
+ ."epg_ch.chtxt=\"".$_[0]."\"";
+ my $ary_db = $dbh->selectall_arrayref($dbe);
+ #print "$ary_db->[0][2]\n";
+ return $ary_db;
+}
+#該当する番組の状況を調べる
+sub check_program{#chtxt#btime#etime#title 0:normal 1:bayesおすすめ 2:jbkおすすめ 8:予約がいっぱい 9:予約済み 10:予約済みduplicate 11: 予約済みepg変更
+ my $ret=0;
+ my $dbt="SELECT type, chtxt, title, btime, etime ,epgduplicate ,epgchange FROM timeline "
+ ."WHERE btime >= \"".$_[1]."\" "
+ ." AND "
+ ."etime <= \"".$_[2]."\""
+ ." AND "
+ ."chtxt = \"".$_[0]."\""
+ ." AND "
+ ."title = \"".$_[3]."\"";
+ my $ary_db = $dbh->selectall_arrayref($dbt);
+ my @ary=@{$ary_db};
+ if ($#ary>-1){##該当が一件以上
+ #die @ary;
+ my @dbl=@ary;
+ #die @dbl;
+ if (int($dbl[5])>0){
+ $ret=10;
+ }elsif (int($dbl[6])>0){
+ $ret=11;
+ }else{
+ $ret=9;
+ }
+ }else{
+ $ret=0;
+ }
+ return $ret;
+}
+sub timesvg{#btime,dtime
+ $svg = SVG -> new(
+ width=>"100%",height=>"100%",
+ );
+ my $btime = $_[0]->strftime( '%Y-%m-%d %H:00:00' );
+ my $bt = Time::Piece->strptime($btime,'%Y-%m-%d %H:%M:%S');
+ $bt = $bt + 3600;
+ for (my $i = 0; $i <= $_[1]-2;$i++){
+ my $btt= $bt + 3600*$i;
+ my $tit = $btt->strftime( '%Y%m%d%H' );
+ if (substr($tit,8,2)eq "00"){
+ $tit = substr($tit,4,2)."/".substr($tit,6,2);
+ }else{
+ $tit = substr($tit,8,2).":00";
+ }
+ my $btime2=$btt-$_[0];
+ my $y=$btime2->minutes;
+ $y=$y*100/60/$_[1];
+ $svg->text(
+ font_size => "100%",
+ x=>"0%",y=>"$y%",
+ -cdata=>$tit
+ );
+ }
+ my $out = $svg->xmlify(
+ -pubid => "-//W3C//DTD SVG 1.1//EN",
+ -dtd => "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd",
+ );
+ my $b ="http:\/\/www\.w3\.org\/TR\/2001\/REC-SVG-20010904\/DTD\/svg10\.dtd";
+ my $e ="http:\/\/www\.w3\.org\/Graphics\/SVG\/1\.1\/DTD\/svg11\.dtd";
+ $out =~ s/$b/$e/;
+ return $out;
+}
+sub chtimesvg{#chtxt,btime,dtime
+ $svg = SVG -> new(
+ width=>"100%",height=>"100%",
+ );
+ my $bt = $_[1];
+ my $btime = $bt->strftime( '%Y%m%d%H%M%S' );
+ my $et = $bt + $_[2]*3600;
+ my $etime = $et->strftime( '%Y%m%d%H%M%S' );
+ my @auto_bayes = @{db_select_epg_ch($_[0],$btime,$etime)};#chtxt#btime#etime
+ my @dbl =@{db_select_epg_ch($_[0],$btime,$etime)};
+ foreach my $tt (@dbl){
+ my @tt2=@{$tt};
+ my $bttime2=substr($tt2[2],0,4)."-".substr($tt2[2],4,2)."-".substr($tt2[2],6,2)
+ ." ".substr($tt2[2],8,2).":".substr($tt2[2],10,2).":".substr($tt2[2],12,2);
+ my $ettime2=substr($tt2[3],0,4)."-".substr($tt2[3],4,2)."-".substr($tt2[3],6,2)
+ ." ".substr($tt2[3],8,2).":".substr($tt2[3],10,2).":".substr($tt2[3],12,2);
+ my $bttime=Time::Piece->strptime($bttime2,'%Y-%m-%d %H:%M:%S');
+ my $ettime=Time::Piece->strptime($ettime2,'%Y-%m-%d %H:%M:%S');
+ my $btime2=$bttime-$bt;
+ my $y=$btime2->minutes;
+ #$y=$y*100/60/$_[2];
+ $y=$y*100/60/$_[2];
+ my $h=($ettime-$bttime);
+ $h=$h->minutes;
+ #$h=$h*100/60/$_[2];
+ $h=$h*100/60/$_[2];
+ my $colin="Snow";
+ my $colout="LemonChiffon";
+ my $colorchar="Black";
+ my $cat = $tt2[6];
+ my $type = 0;##typeは表示タイプ 0:normal 1:bayesおすすめ 2:jbkおすすめ 8:予約がいっぱい 9:予約済み
+
+ foreach my $ab (@auto_bayes){
+ my @ab2=@{$ab};
+ #print "Content-Type: application/xhtml+xml\n\n";
+ #print $ab2[2];
+ my $btt=substr($ab2[2],0,4)."-".substr($ab2[2],4,2)."-".substr($ab2[2],6,2)
+ ." ".substr($ab2[2],8,2).":".substr($ab2[2],10,2).":".substr($ab2[2],12,2);
+ my $ett=substr($ab2[3],0,4)."-".substr($ab2[3],4,2)."-".substr($ab2[3],6,2)
+ ." ".substr($ab2[3],8,2).":".substr($ab2[3],10,2).":".substr($ab2[3],12,2);
+ my $tbtime=Time::Piece->strptime($btt,'%Y-%m-%d %H:%M:%S');
+ my $tetime=Time::Piece->strptime($ett,'%Y-%m-%d %H:%M:%S');
+ if ((($bttime-$tbtime)<30*60)&&(($tetime-$ettime)<30*60)&&(length($tt2[1])>0)&&(length($ab2[1])>0)){
+ my $str1=$tt2[1];
+ utf8::decode($str1);
+ my $str2=$ab2[1];
+ utf8::decode($str2);
+ my %ng=Text::Ngram->ngram_counts({spaces=>0},$str1,2);
+ my $ddbtime=$tbtime-$bttime+1;
+ $ddbtime=abs($ddbtime);
+ my $dp=1000-1000*$ddbtime/(7 * 24 * 60 * 60);
+ my $point=0;
+ use Data::Dumper;
+ while ((my $key,my $value) = each(%ng)){
+ my $i=$str2;
+ #die Dumper($key);
+ $i=$i=~ s/$key//g;
+ if ($i>0){
+ #die $i;
+ $i=90+10*$i;
+ }else{
+ $i=0;
+ }
+ $point += $i;
+ }
+ if ($point>0){
+ $point += $dp;
+ die $point;
+ }
+ if ($point>1200){
+ $type=1;
+ #die $point;
+ }
+ }
+ }
+ #epg_ch.chtxt,title,start,stop,exp,longexp,category
+ $type = check_program($tt2[0],$bttime2,$ettime2,$tt2[1]);
+ utf8::decode($cat);
+ my $title;
+ $title=$tt2[1];
+ if ($cat eq "その他"){
+ $colin="Snow";
+ $colout="LemonChiffon";
+ }elsif($cat eq "情報"){
+ $colin="LightGoldenrodYellow";
+ $colout="Khaki";
+ }elsif ($cat eq "ニュース・報道"){
+ $colin="PeachPuff";
+ $colout="LightPink";
+ }elsif ($cat eq "アニメ・特撮"){
+ $colin="AliceBlue";
+ $colout="DodgerBlue";
+ }elsif ($cat eq "バラエティ"){
+ $colin="LightPink";
+ $colout="Coral";
+ }elsif ($cat eq "スポーツ"){
+ $colin="Honeydew";
+ $colout="GreenYellow";
+ }elsif ($cat eq "音楽"){
+ $colin="Plum";
+ $colout="Orchid";
+ }elsif ($cat eq "映画"){
+ $colin="BurlyWood";
+ $colout="RosyBrown";
+ }
+ if ($type==1){##braviaモード
+ #$colin="white";
+ $colorchar="Green";
+ }elsif ($type==2){##jbkモード
+ $colorchar="Blue";
+ }elsif ($type==8){##予約がいっぱい
+ $colorchar="Gray";
+ }elsif ($type==9){##録画予約済み
+ $colorchar="Orange";
+ }elsif ($type==10){##10:予約済みduplicate
+ $colorchar="Red";
+ }elsif ($type==11){##録画予約済みchange
+ $colorchar="Green";
+ }
+ my $link="rectool.pl?mode=confirm&mode_sub=reserve&chtxt=".$_[0]."&start=".$bttime->strftime( '%Y%m%d%H%M%S' )."&stop=".$ettime->strftime( '%Y%m%d%H%M%S' );
+ getrect(0,$y,100,$h,$title,$tt2[4],$link,$colout,$colin,substr($tt2[2],8,4)." - ".substr($tt2[3],8,4),$colorchar);#x,y,width,height,title,desc,link,colorout,colorin
+ }
+ #print "</body></html>";
+ my $out = $svg->xmlify(
+ -pubid => "-//W3C//DTD SVG 1.1//EN",
+ -dtd => "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd",
+ );
+ my $b ="http:\/\/www\.w3\.org\/TR\/2001\/REC-SVG-20010904\/DTD\/svg10\.dtd";
+ my $e ="http:\/\/www\.w3\.org\/Graphics\/SVG\/1\.1\/DTD\/svg11\.dtd";
+ $out =~ s/$b/$e/;
+ return $out;
+}
+sub getrect(){#x,y,width,height,title,desc,link,colorout,colorin,timedesc,colorfont
+ my $x=shift;
+ my $y=shift;
+ my $width=shift;
+ my $height=shift;
+ my $title=shift;
+ my $desc= shift;
+ my $link= shift;
+ my $colorout= shift;
+ my $colorin = shift;
+ my $timechar = shift;
+ my $colorchar = shift;
+ my $ttxt=$title." ".$desc;
+ utf8::decode($ttxt);
+ utf8::decode($title);
+ utf8::decode($desc);
+ my $anc = $svg -> anchor(
+ -href => $link,
+ 'target' => '_blank',
+ -title => $ttxt
+ );
+ my $bgrec=$anc->group(
+ style=>{stroke=>"black",fill=>"black"}
+ );
+ $bgrec->rectangle(
+ x=>"$x%",y=>"$y%",
+ width=>"$width%",height=>"$height%",
+ rx=>3.0,ry=>3.0,
+ #"stroke-width"=>"3",
+ );
+ my $rec1=$anc->group(
+ #style=>{stroke=>$colorout,fill=>$colorin}
+
+ ##############################test
+ style=>{stroke=>$colorout,fill=>$colorin}
+
+ );
+ my $charcol=$anc->group(
+ style=>{fill=>$colorchar}
+ );
+ $rec1->rectangle(
+ x=>"$x%",y=>"$y%",
+ width=>"$width%",height=>"$height%",
+ rx=>3.0,ry=>3.0,
+ #'onmouseover'=>"evt.target.setAttribute('fill','yellow');",
+ #'onmouseout'=>"evt.target.setAttribute('fill',$colorin);"
+ #"stroke-width"=>"3",
+ );
+ if ($height>4){
+ $charcol ->text(
+ style => {
+ 'font-size' => "60%",
+ },
+
+ x=>"$x%",y=>($y+4)."%",
+ -cdata=>$timechar,
+ );
+ }
+ if ($height>2){
+ $charcol ->text(
+ style => {
+ 'font-size' => "80%",
+ },
+ x=>"$x%",y=>($y+2)."%",
+ -cdata=>$title
+ );
+ }
+ return ;
+}
OSDN Git Service
