Rec10WEBG2/rec10webg2.pl

   1 #!/usr/bin/perl
   2 use strict;
   3 use KCatch;
   4 use Config::Simple;
   5 use DBI;
   6 use CGI::Minimal;
   7 use SVG;
   8 use Time::Piece;
   9 use Encode;
  10 use Text::Ngram;
  11 use utf8;
  12 our $svg="";
  13 our $dbh;
  14 my $cgi=CGI::Minimal->new;
  15 my $nHTML="";
  16
  17 my $cfg = new Config::Simple;
  18 if ( -e '/etc/rec10.conf' ) {
  19         $cfg->read( '/etc/rec10.conf' );
  20 }
  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, {
  29                 AutoCommit => 1,
  30                 RaiseError => 1,
  31         });
  32         $dbh->do( 'SET NAMES utf8' );
  33 }
  34 my $btimenow=localtime;
  35 my $etimenow=$btimenow+12*60*60;
  36 if ($cgi->param('mode') eq "graph"){
  37         $nHTML ="";
  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;
  43         if ($dtime<1){
  44                 $dtime=1;
  45         }
  46         $nHTML .= chtimesvg($cgi->param('chtxt'),$date,$dtime);
  47 }elsif ($cgi->param('mode') eq "timegraph"){
  48         $nHTML ="";
  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;
  54         if ($dtime<1){
  55                 $dtime=1;
  56         }
  57         $nHTML .= timesvg($date,$dtime);
  58 }elsif ($cgi->param('mode') eq "table"){
  59         $nHTML ="";
  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;
  65         if ($dtime<1){
  66                 $dtime=1;
  67         }
  68         $nHTML .= timesvg($date,$dtime);
  69 }else{
  70         if ($cgi->param('btime')ne ""){
  71                 $btimenow=Time::Piece->strptime($cgi->param('btime'),'%Y-%m-%d_%H-%M-%S');
  72         }
  73         if ($cgi->param('etime')ne ""){
  74                 $etimenow=Time::Piece->strptime($cgi->param('etime'),'%Y-%m-%d_%H-%M-%S');
  75         }
  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;
  83         my $hdate=localtime;
  84         $hdate=$hdate+1*60*60;
  85         my $btxtnew1;
  86         my $etxtnew1;
  87         if ($btimenow<$hdate){
  88                 $btxtnew1=$btimenow;
  89                 $etxtnew1=$etimenow;
  90         }else{
  91                 $btxtnew1=$btimenow-18*60*60;
  92                 $etxtnew1=$btimenow;
  93         }
  94         my @clist=@{db_select_chlist()};
  95         my $chtxtlist ="";
  96         if ($ch1 eq ""){
  97                 $ch1=$clist[0][0];
  98         }
  99         if ($ch2 eq ""){
 100                 $ch2=$clist[1][0];
 101         }
 102         if ($ch3 eq ""){
 103                 $ch3=$clist[2][0];
 104         }
 105         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');
 106         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');
 107         foreach my $cht (@clist){
 108                 my @cht2=@{$cht};
 109                 my $chn=$cht2[1];
 110                 utf8::decode($chn);
 111                 $chtxtlist=$chtxtlist."<option value=\"$cht2[0]\">$chn</option>\n";
 112         }
 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&amp;btime=$btxt&amp;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&amp;chtxt=$ch1&amp;btime=$btxt&amp;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&amp;chtxt=$ch2&amp;btime=$btxt&amp;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&amp;chtxt=$ch3&amp;btime=$btxt&amp;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&amp;btime=$btxt&amp;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};
 167 }
 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]."\" "
 173         ."AND "
 174         ."etime <= \"".$_[2]."\""
 175         ."AND "
 176         ."chtxt = \"".$_[0]."\""
 177         );
 178         return $ary_db;
 179 }
 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]."\" "
 184         ."AND "
 185         ."etime <= \"".$_[2]."\""
 186         ."AND "
 187         ."chtxt = \"".$_[0]."\""
 188         );
 189         return $ary_db;
 190 }
 191 sub db_select_timeline{
 192         my $ary_db = $dbh->selectall_arrayref(
 193         "SELECT type, chtxt, title, btime, etime, deltatime ,deltaday ,opt FROM timeline"
 194         );
 195         return $ary_db;
 196 }
 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]."\" "
 201         ." AND "
 202         ."etime <= \"".$_[2]."\""
 203         ."AND "
 204         ."chtxt = \"".$_[0]."\""
 205         );
 206         return $ary_db;
 207 }
 208 sub db_select_chlist{
 209         my $dbe="SELECT chtxt,chname FROM epg_ch";
 210         my $ary_db = $dbh->selectall_arrayref($dbe);
 211         return $ary_db;
 212 }
 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 "
 217         ."AND "
 218         ."start >= \"".$_[1]."\" "
 219         ."AND "
 220         ."stop <= \"".$_[2]."\" "
 221         ."AND "
 222         ."epg_ch.chtxt=\"".$_[0]."\"";
 223         my $ary_db = $dbh->selectall_arrayref($dbe);
 224         #print "$ary_db->[0][2]\n";
 225         return $ary_db;
 226 }
 227 #該当する番組の状況を調べる
 228 sub check_program{#chtxt#btime#etime#title 0:normal 1:bayesおすすめ 2:jbkおすすめ 8:予約がいっぱい 9:予約済み 10:予約済みduplicate 11: 予約済みepg変更
 229         my $ret=0;
 230         my $dbt="SELECT type, chtxt, title, btime, etime ,epgduplicate ,epgchange FROM timeline "
 231         ."WHERE btime >= \"".$_[1]."\" "
 232         ." AND "
 233         ."etime <= \"".$_[2]."\""
 234         ." AND "
 235         ."chtxt = \"".$_[0]."\""
 236         ." AND "
 237         ."title = \"".$_[3]."\"";
 238         my $ary_db = $dbh->selectall_arrayref($dbt);
 239         my @ary=@{$ary_db};
 240         if ($#ary>-1){##該当が一件以上
 241                 #die @ary;
 242                 my @dbl=@ary;
 243                 #die @dbl;
 244                 if (int($dbl[5])>0){
 245                         $ret=10;
 246                 }elsif (int($dbl[6])>0){
 247                         $ret=11;
 248                 }else{
 249                         $ret=9;
 250                 }
 251         }else{
 252                 $ret=0;
 253         }
 254         return $ret;
 255 }
 256 sub timesvg{#btime,dtime
 257         $svg = SVG -> new(
 258                 width=>"100%",height=>"100%",
 259                 );
 260         my $btime = $_[0]->strftime( '%Y-%m-%d %H:00:00' );
 261         my $bt = Time::Piece->strptime($btime,'%Y-%m-%d %H:%M:%S');
 262         $bt = $bt + 3600;
 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);
 268                 }else{
 269                         $tit = substr($tit,8,2).":00";
 270                 }
 271                 my $btime2=$btt-$_[0];
 272                 my $y=$btime2->minutes;
 273                 $y=$y*100/60/$_[1];
 274                 $svg->text(
 275                         font_size => "100%",
 276                         x=>"0%",y=>"$y%",
 277                         -cdata=>$tit
 278                 );
 279         }
 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",
 283         );
 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";
 286         $out =~ s/$b/$e/;
 287         return $out;
 288 }
 289 sub chtimesvg{#chtxt,btime,dtime
 290         $svg = SVG -> new(
 291                 width=>"100%",height=>"100%",
 292                 );
 293         my $bt = $_[1];
 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){
 300                 my @tt2=@{$tt};
 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;
 309                 #$y=$y*100/60/$_[2];
 310                 $y=$y*100/60/$_[2];
 311                 my $h=($ettime-$bttime);
 312                 $h=$h->minutes;
 313                 #$h=$h*100/60/$_[2];
 314                 $h=$h*100/60/$_[2];
 315                 my $colin="Snow";
 316                 my $colout="LemonChiffon";
 317                 my $colorchar="Black";
 318                 my $cat = $tt2[6];
 319                 my $type = 0;##typeは表示タイプ 0:normal 1:bayesおすすめ 2:jbkおすすめ 8:予約がいっぱい 9:予約済み
 320
 321                 foreach my $ab (@auto_bayes){
 322                         my @ab2=@{$ab};
 323                         #print "Content-Type: application/xhtml+xml\n\n";
 324                         #print $ab2[2];
 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)){
 332                                 my $str1=$tt2[1];
 333                                 utf8::decode($str1);
 334                                 my $str2=$ab2[1];
 335                                 utf8::decode($str2);
 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);
 340                                 my $point=0;
 341                                 use Data::Dumper;
 342                                 while ((my $key,my $value) = each(%ng)){
 343                                         my $i=$str2;
 344                                         #die Dumper($key);
 345                                         $i=$i=~ s/$key//g;
 346                                         if ($i>0){
 347                                                 #die $i;
 348                                                 $i=90+10*$i;
 349                                         }else{
 350                                                 $i=0;
 351                                         }
 352                                         $point += $i;
 353                                 }
 354                                 if ($point>0){
 355                                         $point += $dp;
 356                                         die $point;
 357                                 }
 358                                 if ($point>1200){
 359                                         $type=1;
 360                                         #die $point;
 361                                 }
 362                         }
 363                 }
 364                 #epg_ch.chtxt,title,start,stop,exp,longexp,category
 365                 $type = check_program($tt2[0],$bttime2,$ettime2,$tt2[1]);
 366                 utf8::decode($cat);
 367                 my $title;
 368                 $title=$tt2[1];
 369                 if ($cat eq "その他"){
 370                         $colin="Snow";
 371                         $colout="LemonChiffon";
 372                 }elsif($cat eq "情報"){
 373                         $colin="LightGoldenrodYellow";
 374                         $colout="Khaki";
 375                 }elsif ($cat eq "ニュース・報道"){
 376                         $colin="PeachPuff";
 377                         $colout="LightPink";
 378                 }elsif ($cat eq "アニメ・特撮"){
 379                         $colin="AliceBlue";
 380                         $colout="DodgerBlue";
 381                 }elsif ($cat eq "バラエティ"){
 382                         $colin="LightPink";
 383                         $colout="Coral";
 384                 }elsif ($cat eq "スポーツ"){
 385                         $colin="Honeydew";
 386                         $colout="GreenYellow";
 387                 }elsif ($cat eq "音楽"){
 388                         $colin="Plum";
 389                         $colout="Orchid";
 390                 }elsif ($cat eq "映画"){
 391                         $colin="BurlyWood";
 392                         $colout="RosyBrown";
 393                 }
 394                 if ($type==1){##braviaモード
 395                         #$colin="white";
 396                         $colorchar="Green";
 397                 }elsif ($type==2){##jbkモード
 398                         $colorchar="Blue";
 399                 }elsif ($type==8){##予約がいっぱい
 400                         $colorchar="Gray";
 401                 }elsif ($type==9){##録画予約済み
 402                         $colorchar="Orange";
 403                 }elsif ($type==10){##10:予約済みduplicate
 404                         $colorchar="Red";
 405                 }elsif ($type==11){##録画予約済みchange
 406                         $colorchar="Green";
 407                 }
 408                 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' );
 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
 410         }
 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",
 415         );
 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";
 418         $out =~ s/$b/$e/;
 419         return $out;
 420 }
 421 sub getrect(){#x,y,width,height,title,desc,link,colorout,colorin,timedesc,colorfont
 422         my $x=shift;
 423         my $y=shift;
 424         my $width=shift;
 425         my $height=shift;
 426         my $title=shift;
 427         my $desc= shift;
 428         my $link= shift;
 429         my $colorout= shift;
 430         my $colorin = shift;
 431         my $timechar = shift;
 432         my $colorchar = shift;
 433         my $ttxt=$title."    ".$desc;
 434         utf8::decode($ttxt);
 435         utf8::decode($title);
 436         utf8::decode($desc);
 437         my $anc = $svg -> anchor(
 438         -href => $link,
 439         'target' => '_blank',
 440         -title => $ttxt
 441         );
 442         my $bgrec=$anc->group(
 443                 style=>{stroke=>"black",fill=>"black"}
 444         );
 445         $bgrec->rectangle(
 446                 x=>"$x%",y=>"$y%",
 447                 width=>"$width%",height=>"$height%",
 448                 rx=>3.0,ry=>3.0,
 449                 #"stroke-width"=>"3",
 450         );
 451         my $rec1=$anc->group(
 452                 #style=>{stroke=>$colorout,fill=>$colorin}
 453
 454                 ##############################test
 455                 style=>{stroke=>$colorout,fill=>$colorin}
 456
 457         );
 458         my $charcol=$anc->group(
 459                 style=>{fill=>$colorchar}
 460         );
 461         $rec1->rectangle(
 462                 x=>"$x%",y=>"$y%",
 463                 width=>"$width%",height=>"$height%",
 464                 rx=>3.0,ry=>3.0,
 465                 #'onmouseover'=>"evt.target.setAttribute('fill','yellow');",
 466                 #'onmouseout'=>"evt.target.setAttribute('fill',$colorin);"
 467                 #"stroke-width"=>"3",
 468         );
 469         if ($height>4){
 470                 $charcol ->text(
 471                         style => {
 472                                 'font-size' => "60%",
 473                         },
 474
 475                         x=>"$x%",y=>($y+4)."%",
 476                         -cdata=>$timechar,
 477                 );
 478         }
 479         if ($height>2){
 480                 $charcol ->text(
 481                         style => {
 482                                 'font-size' => "80%",
 483                         },
 484                         x=>"$x%",y=>($y+2)."%",
 485                         -cdata=>$title
 486                 );
 487         }
 488         return ;
 489 }