14 my $cgi=CGI::Minimal->new;
17 my $cfg = new Config::Simple;
18 if ( -e '/etc/rec10.conf' ) {
19 $cfg->read( '/etc/rec10.conf' );
21 my $sql = $cfg->param( 'db.db' );
22 if ( $sql eq 'MySQL') {
23 my $name = $cfg->param( 'db.mysql_dbname' );
24 my $host = $cfg->param( 'db.mysql_host' );
25 my $port = $cfg->param( 'db.mysql_port' );
26 my $user = $cfg->param( 'db.mysql_user' );
27 my $pass = $cfg->param( 'db.mysql_passwd' );
28 $dbh = DBI->connect("dbi:mysql:$name:$host:$port", $user, $pass, {
32 $dbh->do( 'SET NAMES utf8' );
34 my $btimenow=localtime;
35 my $etimenow=$btimenow+12*60*60;
36 if ($cgi->param('mode') eq "graph"){
38 $nHTML = qq {Content-type:image/svg+xml\n\n};
39 my $date = Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
40 my $date2 = Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
41 my $ddate = $date2-$date;
42 my $dtime = $ddate->hours;
46 $nHTML .= chtimesvg($cgi->param('chtxt'),$date,$dtime);
47 }elsif ($cgi->param('mode') eq "timegraph"){
49 $nHTML = qq {Content-type:image/svg+xml\n\n};
50 my $date = Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
51 my $date2 = Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
52 my $ddate = $date2-$date;
53 my $dtime = $ddate->hours;
57 $nHTML .= timesvg($date,$dtime);
58 }elsif ($cgi->param('mode') eq "table"){
60 $nHTML = qq {Content-type:application/xhtml+xml\n\n};
61 my $date = Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
62 my $date2 = Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
63 my $ddate = $date2-$date;
64 my $dtime = $ddate->hours;
68 $nHTML .= timesvg($date,$dtime);
70 if ($cgi->param('btime')ne ""){
71 $btimenow=Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
73 if ($cgi->param('etime')ne ""){
74 $etimenow=Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
76 my $ch1=$cgi->param('ch1');
77 my $ch2=$cgi->param('ch2');
78 my $ch3=$cgi->param('ch3');
79 my $btxt=$btimenow->strftime('%Y-%m-%d_%H-00-00');
80 my $etxt=$etimenow->strftime('%Y-%m-%d_%H-00-00');
81 my $btxtnew2=$etimenow;
82 my $etxtnew2=$etimenow+18*60*60;
84 $hdate=$hdate+1*60*60;
87 if ($btimenow<$hdate){
91 $btxtnew1=$btimenow-18*60*60;
94 my @clist=@{db_select_chlist()};
105 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');
106 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');
107 foreach my $cht (@clist){
111 $chtxtlist=$chtxtlist."<option value=\"$cht2[0]\">$chn</option>\n";
113 my $chtxtlist1 = $chtxtlist;
114 my $chtxtlist2 = $chtxtlist;
115 my $chtxtlist3 = $chtxtlist;
116 $chtxtlist1 =~ s/$ch1"/$ch1" selected="selected"/;
117 $chtxtlist2 =~ s/$ch2"/$ch2" selected="selected"/;
118 $chtxtlist3 =~ s/$ch3"/$ch3" selected="selected"/;
119 $nHTML .= qq {Content-type:application/xhtml+xml\n\n};
120 $nHTML .= qq {<?xml version="1.0" encoding="UTF-8"?>\n};
121 $nHTML .= qq {<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"\n"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">\n};
122 $nHTML .= qq {<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja" lang="ja">\n};
123 $nHTML .= qq {<head>\n};
124 $nHTML .= qq {<title>Rec10WEB G2 番組表 ver alpha 2010-03-15};
125 $nHTML .= qq {</title>\n};
126 $nHTML .= qq {</head>\n};
127 $nHTML .= qq {<body>\n};
128 $nHTML .= qq {<form action="rec10webg2.pl">\n};
129 $nHTML .= qq {<p>Rec10WEB G2 alpha</p>\n};
130 $nHTML .= qq {<p>Rec10 番組表</p>\n};
131 $nHTML .= qq {<p style="width:100%;height:10%;buttom:2%;position:relative;">};
132 $nHTML .= qq {<select size="1" name="ch1" style="left:3%;width:30%;height:100%;position:relative;">\n};
133 $nHTML .= $chtxtlist1;
134 $nHTML .= qq {</select>\n};
135 $nHTML .= qq {<select size="1" name="ch2" style="left:3%;width:30%;height:100%;position:relative;">\n};
136 $nHTML .= $chtxtlist2;
137 $nHTML .= qq {</select>\n};
138 $nHTML .= qq {<select size="1" name="ch3" style="left:3%;width:30%;height:100%;position:relative;">\n};
139 $nHTML .= $chtxtlist3;
140 $nHTML .= qq {</select>\n};
141 $nHTML .= qq {<input type="submit" name="submit" value="表示" style="left:3%;width:3%;position:relative;"/>\n};
142 $nHTML .= qq {</p>\n};
143 $nHTML .= qq {<div style="width:100%;height:82%;bottom:3%;position:fixed;">\n};
144 $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=timegraph&btime=$btxt&etime=$etxt" style="width:3%;height:100%;">\n};
145 $nHTML .= qq {SVG Timeline\n};
146 $nHTML .= qq {</object>\n};
147 $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=graph&chtxt=$ch1&btime=$btxt&etime=$etxt" style="width:30%;height:100%;">\n};
148 $nHTML .= qq {SVG Timeline\n};
149 $nHTML .= qq {</object>\n};
150 $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=graph&chtxt=$ch2&btime=$btxt&etime=$etxt" style="width:30%;height:100%;">\n};
151 $nHTML .= qq {SVG Timeline\n};
152 $nHTML .= qq {</object>\n};
153 $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=graph&chtxt=$ch3&btime=$btxt&etime=$etxt" style="width:30%;height:100%;">\n};
154 $nHTML .= qq {SVG Timeline\n};
155 $nHTML .= qq {</object>\n};
156 $nHTML .= qq {<object type="image/svg+xml" data="rec10webg2.pl?mode=timegraph&btime=$btxt&etime=$etxt" style="width:3%;height:100%;">\n};
157 $nHTML .= qq {SVG Timeline\n};
158 $nHTML .= qq {</object>\n};
159 $nHTML .= qq {</div>\n};
160 $nHTML .= qq {<p style="bottom:1%;position:fixed;">\n};
161 $nHTML .= qq {<a href="$blink" style="left:0%;position:fixed;">前へ</a>\n};
162 $nHTML .= qq {<a href="$alink" style="right:3%;position:fixed;">次へ</a>\n};
163 $nHTML .= qq {</p>\n};
164 $nHTML .= qq {</form>\n};
165 $nHTML .= qq {</body>\n};
166 $nHTML .= qq {</html>\n};
168 print encode('utf-8',$nHTML);
169 sub db_select_auto_bayes_timeline{#chtxt,btime,etime
170 my $ary_db = $dbh->selectall_arrayref(
171 "SELECT chtxt,title, btime, etime, point FROM auto_timeline_bayes"
172 ."WHERE btime >= \"".$_[1]."\" "
174 ."etime <= \"".$_[2]."\""
176 ."chtxt = \"".$_[0]."\""
180 sub db_select_auto_jbk_timeline{#chtxt,btime,etime
181 my $ary_db = $dbh->selectall_arrayref(
182 "SELECT chtxt,title, btime, etime, point FROM auto_timeline_keyword"
183 ."WHERE btime >= \"".$_[1]."\" "
185 ."etime <= \"".$_[2]."\""
187 ."chtxt = \"".$_[0]."\""
191 sub db_select_timeline{
192 my $ary_db = $dbh->selectall_arrayref(
193 "SELECT type, chtxt, title, btime, etime, deltatime ,deltaday ,opt FROM timeline"
197 sub db_select_chtxt_btime_etime_timeline{#chtxt,btime,etime
198 my $ary_db = $dbh->selectall_arrayref(
199 "SELECT type, chtxt, title, btime, etime FROM timeline"
200 ."WHERE btime >= \"".$_[1]."\" "
202 ."etime <= \"".$_[2]."\""
204 ."chtxt = \"".$_[0]."\""
208 sub db_select_chlist{
209 my $dbe="SELECT chtxt,chname FROM epg_ch";
210 my $ary_db = $dbh->selectall_arrayref($dbe);
213 sub db_select_epg_ch{#chtxt#btime#etime
214 my $dbe="SELECT epg_ch.chtxt,title,start,stop,exp,longexp,category FROM epg_timeline "
215 ."INNER JOIN epg_ch "
216 ."WHERE epg_ch.ontv=epg_timeline.channel "
218 ."start >= \"".$_[1]."\" "
220 ."stop <= \"".$_[2]."\" "
222 ."epg_ch.chtxt=\"".$_[0]."\"";
223 my $ary_db = $dbh->selectall_arrayref($dbe);
224 #print "$ary_db->[0][2]\n";
228 sub check_program{#chtxt#btime#etime#title 0:normal 1:bayesおすすめ 2:jbkおすすめ 8:予約がいっぱい 9:予約済み 10:予約済みduplicate 11: 予約済みepg変更
230 my $dbt="SELECT type, chtxt, title, btime, etime ,epgduplicate ,epgchange FROM timeline "
231 ."WHERE btime >= \"".$_[1]."\" "
233 ."etime <= \"".$_[2]."\""
235 ."chtxt = \"".$_[0]."\""
237 ."title = \"".$_[3]."\"";
238 my $ary_db = $dbh->selectall_arrayref($dbt);
240 if ($#ary>-1){##該当が一件以上
246 }elsif (int($dbl[6])>0){
256 sub timesvg{#btime,dtime
258 width=>"100%",height=>"100%",
260 my $btime = $_[0]->strftime( '%Y-%m-%d %H:00:00' );
261 my $bt = Time::Piece->strptime($btime,'%Y-%m-%d %H:%M:%S');
263 for (my $i = 0; $i <= $_[1]-2;$i++){
264 my $btt= $bt + 3600*$i;
265 my $tit = $btt->strftime( '%Y%m%d%H' );
266 if (substr($tit,8,2)eq "00"){
267 $tit = substr($tit,4,2)."/".substr($tit,6,2);
269 $tit = substr($tit,8,2).":00";
271 my $btime2=$btt-$_[0];
272 my $y=$btime2->minutes;
280 my $out = $svg->xmlify(
281 -pubid => "-//W3C//DTD SVG 1.1//EN",
282 -dtd => "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd",
284 my $b ="http:\/\/www\.w3\.org\/TR\/2001\/REC-SVG-20010904\/DTD\/svg10\.dtd";
285 my $e ="http:\/\/www\.w3\.org\/Graphics\/SVG\/1\.1\/DTD\/svg11\.dtd";
289 sub chtimesvg{#chtxt,btime,dtime
291 width=>"100%",height=>"100%",
294 my $btime = $bt->strftime( '%Y%m%d%H%M%S' );
295 my $et = $bt + $_[2]*3600;
296 my $etime = $et->strftime( '%Y%m%d%H%M%S' );
297 my @auto_bayes = @{db_select_epg_ch($_[0],$btime,$etime)};#chtxt#btime#etime
298 my @dbl =@{db_select_epg_ch($_[0],$btime,$etime)};
299 foreach my $tt (@dbl){
301 my $bttime2=substr($tt2[2],0,4)."-".substr($tt2[2],4,2)."-".substr($tt2[2],6,2)
302 ." ".substr($tt2[2],8,2).":".substr($tt2[2],10,2).":".substr($tt2[2],12,2);
303 my $ettime2=substr($tt2[3],0,4)."-".substr($tt2[3],4,2)."-".substr($tt2[3],6,2)
304 ." ".substr($tt2[3],8,2).":".substr($tt2[3],10,2).":".substr($tt2[3],12,2);
305 my $bttime=Time::Piece->strptime($bttime2,'%Y-%m-%d %H:%M:%S');
306 my $ettime=Time::Piece->strptime($ettime2,'%Y-%m-%d %H:%M:%S');
307 my $btime2=$bttime-$bt;
308 my $y=$btime2->minutes;
311 my $h=($ettime-$bttime);
316 my $colout="LemonChiffon";
317 my $colorchar="Black";
319 my $type = 0;##typeは表示タイプ 0:normal 1:bayesおすすめ 2:jbkおすすめ 8:予約がいっぱい 9:予約済み
321 foreach my $ab (@auto_bayes){
323 #print "Content-Type: application/xhtml+xml\n\n";
325 my $btt=substr($ab2[2],0,4)."-".substr($ab2[2],4,2)."-".substr($ab2[2],6,2)
326 ." ".substr($ab2[2],8,2).":".substr($ab2[2],10,2).":".substr($ab2[2],12,2);
327 my $ett=substr($ab2[3],0,4)."-".substr($ab2[3],4,2)."-".substr($ab2[3],6,2)
328 ." ".substr($ab2[3],8,2).":".substr($ab2[3],10,2).":".substr($ab2[3],12,2);
329 my $tbtime=Time::Piece->strptime($btt,'%Y-%m-%d %H:%M:%S');
330 my $tetime=Time::Piece->strptime($ett,'%Y-%m-%d %H:%M:%S');
331 if ((($bttime-$tbtime)<30*60)&&(($tetime-$ettime)<30*60)&&(length($tt2[1])>0)&&(length($ab2[1])>0)){
336 my %ng=Text::Ngram->ngram_counts({spaces=>0},$str1,2);
337 my $ddbtime=$tbtime-$bttime+1;
338 $ddbtime=abs($ddbtime);
339 my $dp=1000-1000*$ddbtime/(7 * 24 * 60 * 60);
342 while ((my $key,my $value) = each(%ng)){
364 #epg_ch.chtxt,title,start,stop,exp,longexp,category
365 $type = check_program($tt2[0],$bttime2,$ettime2,$tt2[1]);
371 $colout="LemonChiffon";
372 }elsif($cat eq "情報"){
373 $colin="LightGoldenrodYellow";
375 }elsif ($cat eq "ニュース・報道"){
378 }elsif ($cat eq "アニメ・特撮"){
380 $colout="DodgerBlue";
381 }elsif ($cat eq "バラエティ"){
384 }elsif ($cat eq "スポーツ"){
386 $colout="GreenYellow";
387 }elsif ($cat eq "音楽"){
390 }elsif ($cat eq "映画"){
394 if ($type==1){##braviaモード
397 }elsif ($type==2){##jbkモード
399 }elsif ($type==8){##予約がいっぱい
401 }elsif ($type==9){##録画予約済み
403 }elsif ($type==10){##10:予約済みduplicate
405 }elsif ($type==11){##録画予約済みchange
408 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' );
409 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
411 #print "</body></html>";
412 my $out = $svg->xmlify(
413 -pubid => "-//W3C//DTD SVG 1.1//EN",
414 -dtd => "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd",
416 my $b ="http:\/\/www\.w3\.org\/TR\/2001\/REC-SVG-20010904\/DTD\/svg10\.dtd";
417 my $e ="http:\/\/www\.w3\.org\/Graphics\/SVG\/1\.1\/DTD\/svg11\.dtd";
421 sub getrect(){#x,y,width,height,title,desc,link,colorout,colorin,timedesc,colorfont
431 my $timechar = shift;
432 my $colorchar = shift;
433 my $ttxt=$title." ".$desc;
435 utf8::decode($title);
437 my $anc = $svg -> anchor(
439 'target' => '_blank',
442 my $bgrec=$anc->group(
443 style=>{stroke=>"black",fill=>"black"}
447 width=>"$width%",height=>"$height%",
449 #"stroke-width"=>"3",
451 my $rec1=$anc->group(
452 #style=>{stroke=>$colorout,fill=>$colorin}
454 ##############################test
455 style=>{stroke=>$colorout,fill=>$colorin}
458 my $charcol=$anc->group(
459 style=>{fill=>$colorchar}
463 width=>"$width%",height=>"$height%",
465 #'onmouseover'=>"evt.target.setAttribute('fill','yellow');",
466 #'onmouseout'=>"evt.target.setAttribute('fill',$colorin);"
467 #"stroke-width"=>"3",
472 'font-size' => "60%",
475 x=>"$x%",y=>($y+4)."%",
482 'font-size' => "80%",
484 x=>"$x%",y=>($y+2)."%",