#!/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&amp;ch2=$ch2&amp;ch3=$ch3&amp;btime=".$btxtnew1->strftime('%Y-%m-%d_%H-%M-%S')."&amp;etime=".$etxtnew1->strftime('%Y-%m-%d_%H-%M-%S');
	my $alink="rec10webg2.pl?ch1=$ch1&amp;ch2=$ch2&amp;ch3=$ch3&amp;btime=".$btxtnew2->strftime('%Y-%m-%d_%H-%M-%S')."&amp;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&amp;btime=$btxt&amp;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&amp;chtxt=$ch1&amp;btime=$btxt&amp;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&amp;chtxt=$ch2&amp;btime=$btxt&amp;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&amp;chtxt=$ch3&amp;btime=$btxt&amp;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&amp;btime=$btxt&amp;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&amp;mode_sub=reserve&amp;chtxt=".$_[0]."&amp;start=".$bttime->strftime( '%Y%m%d%H%M%S' )."&amp;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 ;
}
