Rec10%HTML_TITLE

\n}; my $ary_ref = $dbh->selectall_arrayref( + "SELECT id, type, rectime.chtxt, chdata.ontv, ch.display, title, btime, etime, opt, deltaday, deltatime + FROM rectime + INNER JOIN chdata ON rectime.chtxt = chdata.chtxt + INNER JOIN ch ON chdata.ontv = ch.channel + ORDER BY $order"); + + $HTML .= qq {

\n}; + $HTML .= qq {

\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + foreach my $line ( @{ $ary_ref } ) { + + $type = $type{$line->[1]} || $line->[1]; + if ( $line->[1] eq 'key' || $line->[1] eq 'keyevery' ) { + $type = qq {$type}; + $line->[9] = qq {ç©º} if ( !$line->[9] && $line->[1] eq 'keyevery' ); + $line->[10] = qq {ç©º} if ( !$line->[10] ); + } + elsif ( $line->[1] eq 'res' || $line->[1] eq 'rec' ) { + $type = qq {$type}; + } + elsif ( $line->[1] eq 'tsrecording' ) { + $type = qq {$type}; + } + elsif ( $line->[1] eq 'b252ts' || $line->[1] eq 'ts2avi' ) { + $type = qq {$type}; + } + elsif ( $line->[1] eq 'tsdecoding' ) { + $type = qq {$type}; + } + elsif ( $line->[1] eq 'local' ) { + $type = qq {$type}; + } + else { + $type = qq {$type}; + } + $display = $q->url_encode( $line->[4] ); + $line->[5] = 'ã¿ã¤ãã«ãªã' if ( !$line->[5] ); + my @unix_6 = $line->[6] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/; + my $unix_6 = DateTime->new( + year => $unix_6[0], month => $unix_6[1], day => $unix_6[2], + hour => $unix_6[3], minute => $unix_6[4], second => $unix_6[5], + time_zone => $tz + ); + my @unix_7 = $line->[7] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/; + my $unix_7 = DateTime->new( + year => $unix_7[0], month => $unix_7[1], day => $unix_7[2], + hour => $unix_7[3], minute => $unix_7[4], second => $unix_7[5], + time_zone => $tz + ); + + my $btime = $unix_6->strftime( '%Y%m%d%H%M%S' ); + my $etime = $unix_7->strftime( '%Y%m%d%H%M%S' ); + if ( $extra and $line->[1] =~ /key|res/ ) { + my @ary = $dbh->selectrow_array( + "SELECT title, exp FROM tv + WHERE channel = '$line->[3]' + AND start = '$btime' + AND stop = '$etime' "); + $ary[0] = 'èª¬æ' if ( $line->[1] eq 'res' ); + if ( $ary[0] ) { + $ary[0] =~ s/ç¡æâ«//; + if ( $line->[1] ne 'res' && $ary[0] ne $line->[5] ) { + my $count = $ary[0] =~ s/\Q$line->[5]\E//; + if ( !$count ) { + $ary[0] = qq {$ary[0]}; + } + } + if ( $ary[1] ) { + $line->[11] = qq {

$ary[0]

}; + } + else { + # $line->[11] = qq {è©²å½ãªã}; + $line->[11] = qq {èª¬æãªã}; + } + } + else { + my $href = qq {èªåæ¤ç´¢}; + $line->[11] = qq {ï¼$hrefï¼}; + } + } + + my $begin = $unix_6->strftime( '%m/%d %H:%M' ); + my $end; + if ( $unix_6->month == $unix_7->month && $unix_6->day == $unix_7->day ) + { + $end = $unix_7->strftime( '%H:%M' ); + } + else { + $end = $unix_7->strftime( 'ç¿ %H:%M' ); + } + + my ( $sec, $min, $hour ); + $sec = $unix_7->epoch - $unix_6->epoch; + $min = int( $sec / 60 ); + $sec = $sec - $min * 60; + $hour = int( $min / 60 ); + $min = $min - $hour * 60; + my $diff = ''; + $diff .= $hour . 'æé' if ( $hour ); + $diff .= $min . 'å' if ( $min ); + $diff .= $sec . 'ç§' if ( $sec ); + + my $hr; + if ( + $line->[1] eq 'tsrecording' + && + $unix_6->epoch <= time && time <= $unix_7->epoch + ) + { + $percent = int( ( 100 * ( time - $unix_6->epoch ) ) / ( $unix_7->epoch - $unix_6->epoch ) ); + $hr .= qq {

}; + } + + $line->[5] = qq {

$line->[5]

} if ( $line->[11] ); + $line->[5] = qq {$line->[5]}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n\n\n}; + # $HTML .= qq {\n} if ( $extra ); + $HTML .= qq {\n}; + } + $HTML .= qq {

â	ID	ã¿ã¤ã	ãã£ã³ãã«	ã¿ã¤ãã«	éå§æå»	çµäºæå»	é²ç»æé	ãªãã·ã§ã³	dd	dt
	$line->[0]	$type	$line->[2]	$line->[5]$line->[11]	$begin	$end	$hr$diff	$line->[8]	$line->[9]	$line->[10]	$line->[11]

\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n

\n}; + goto end; +} + +if ( $mode eq 'graph' ) { + + $graph = $q->param( 'graph' ); + + if ( $graph ) + { + print "Content-Type: image/svg+xml\n\n"; + + require SVG; + $graph = Date::Simple->new( split /-/, $graph ); + $graph_bgn = $graph->format('%Y-%m-%d'); + $graph_end = $graph->next->format('%Y-%m-%d'); + $day = $graph->day; + $today = $graph eq Date::Simple->today() ? 1 : 0; + + $tuner{terrestrial} = 2; #$cfg->param( 'env.te_max' ); + $tuner{satellite} = 4; #$cfg->param( 'env.bscs_max' ); + $tuner{all} = $tuner{terrestrial} + $tuner{satellite}; + $hours = 24; + $width = 30 * $hours; + + $svg = new SVG( width => 820, height => $tuner{all} * 20 + 40 ); + $svg->rectangle( 'x' => 40, 'y' => 20, + width => $width + 20, height => $tuner{all} * 20 + 10, + rx => 15, ry => 15, + style => { stroke => 'blue', fill => 'white' } ); + for ( 1..$tuner{terrestrial} ) { + $svg->text( 'x' => 10, 'y' => ( $_ + 1 ) * 20 ) + ->cdata( "T$_" ); + } + for ( 1..$tuner{satellite} ) { + $svg->text( 'x' => 10, 'y' => ( $_ + $tuner{terrestrial} + 1 ) * 20 ) + ->cdata( "S$_" ); + } + for ( 0..$hours ) { + $svg->text( 'x' => $_ * 30 + 65, 'y' => 15, + style => { 'text-anchor' => 'middle' } ) + ->cdata( sprintf( '%02d', $_ ) ) if ( $_ < $hours ); +# $svg->line( ); # can't use when required + $svg->tag( 'line', x1 => $_ * 30 + 50, x2 => $_ * 30 + 50, y1 => 30, y2 => $tuner{all} * 20 + 20, + style => { stroke => 'gray' } ); + } + for ( 1..$tuner{all} ) { + $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 ); + } + if ( $today ) { + require Time::Simple; + my $time = Time::Simple->new(); + my $x = ( $time->hours * 60 + $time->minutes ) * 0.5 + 50; + $svg->tag( 'line', x1 => $x, x2 => $x, y1 => 30, y2 => $tuner{all} * 20 + 20, + style => { stroke => 'red', 'fill-opacity' => '1.0' } ); + } + foreach my $bctype ( 'te%', '_s%' ) { + my $tuner = $bctype eq 'te%' ? $tuner{terrestrial} : $tuner{satellite}; + my $ary_ref = $dbh->selectall_arrayref( + "SELECT id, type, rectime.chtxt, title, btime, etime, opt FROM rectime + INNER JOIN chdata ON rectime.chtxt = chdata.chtxt + WHERE chdata.bctype LIKE '$bctype' + AND type IN ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' ) + AND + ( + '$graph_bgn 00:00' <= btime AND btime < '$graph_end 00:00' + OR + '$graph_bgn 00:00' < etime AND etime <= '$graph_end 00:00' + ) + ORDER BY id" + ); + foreach my $line ( @{ $ary_ref } ) { + @start = $line->[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/; + @stop = $line->[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/; + $start = ( ( $day == $start[2] ? 0 : 24 * 60 ) + $start[3] * 60 + $start[4] ) * 0.5; + $stop = ( ( $day == $stop [2] ? 0 : 24 * 60 ) + $stop [3] * 60 + $stop [4] ) * 0.5; + $start = 0 if ( $start < 0 || $day > $start[2] ); # æã®å¤ããç®ã¯ã¹ã«ã¼ + $stop = $width if ( $stop > $width ); + $begin = $line->[4]; + $end = $line->[5]; + + my $ary = $dbh->selectall_arrayref( + "SELECT id, type, rectime.chtxt, title, btime, etime, opt FROM rectime + INNER JOIN chdata ON rectime.chtxt = chdata.chtxt + WHERE chdata.bctype LIKE '$bctype' + AND type IN ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' ) + AND NOT + ( + ( etime <= '$begin' ) + OR + ( btime >= '$end' ) + ) + ORDER BY id" + ); + my @ary = @{$ary}; + for ( 0..$tuner - 1 ) { + $f = 1; + $i = $_; + for ( 0..4 ) { + $f = 0 if ( $line->[$_] ne $ary[$i]->[$_] ); + } + if ( $f ) { + $slot = $i; + } + } + my ( $r, $g, $b ) = ( 0, 0, 0 ); + $r += 255 if ( $line->[6] =~ /a/ ); + $g += 255 if ( $line->[6] =~ /H/ ); + $b += 255 if ( $line->[6] =~ /2/ ); + if ( $r + $g + $b == 255 * 3 ){ + $r = 0; + $g = 255; + $b = 255; + } + if ( $r + $g + $b == 0 ){ + $r = $g = $b = 128; + } + my %escaped = ( '&' => 'amp', '<' => 'lt', '>' => 'gt', '"' => 'quot' ); + sub html_escape{ + my $str = shift or return; + my $result = ''; + $result .= $escaped{$_} ? '&' . $escaped{$_} . ';' : $_ + for (split //, $str); + $result; + } + $svg->anchor( + -href => "rectool.pl?mode=edit&id=$line->[0]", + target => '_blank', + -title => html_escape( $line->[3] ), + )->rectangle( + 'x' => 50 + $start, + 'y' => 30 + ( $bctype eq 'te%' ? 0 : $tuner{terrestrial} * 20 ) + $slot * 20, + width => $stop - $start, + height => 10, + style => { fill => "rgb($r,$g,$b)" } ); + } + } + print $svg->xmlify; + exit; + } + else + { + $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer - Graphical/; + $HTML .= qq {

\n}; +# $base64 = encode_base64( $svg->xmlify ); +# $HTML .= qq {

\n}; + $HTML .= qq {äºç´ç¶æ³ä¸è¦§ã§ããT1,T2ã¯å°ä¸æ³¢ãS1,S2ã¯BS/CSãèµ¤ã¯ã¢ãã¡ãç·ã¯HDãéã¯2 passãç¤ºãã¦ãã¾ãã
\n}; + $HTML .= qq {SVGãå©ç¨å¯è½ãªãã©ã¦ã¶ã§ãè¦§ãã ããã
\n}; + + $ary_ref = $dbh->selectcol_arrayref( +# "SELECT DISTINCT SUBSTR( btime, 0, 11 ) + "SELECT DISTINCT DATE( btime ) + FROM rectime + WHERE type in ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' ) + ORDER BY btime" + ); + foreach my $date ( @{ $ary_ref } ) { + my @date = $date =~ /(.{4})-(.{2})-(.{2})/; + my $dn = DateTime->new( year => $date[0], month => $date[1], day => $date[2], locale => 'ja_JP' )->day_name; + utf8::encode( $dn ); + $HTML .= qq {$date[1]/$date[2]($dn)ã®äºç´ç¶æ³
\n}; + $HTML .= qq {

\n
\n}; + + $date2 = Date::Simple->new( @date )->next->format('%Y-%m-%d'); + my $ary_ref = $dbh->selectall_arrayref( + "SELECT chtxt, title, btime, etime FROM rectime + WHERE '$date 00:00' <= btime AND etime <= '$date2 01:00' + ORDER BY btime" + ); + + foreach my $line ( @{ $ary_ref } ) { +# $HTML .= qq {$line->[0] $line->[1] $line->[2] $line->[3]
\n}; + } + + } + + goto end; + } +} + +if ( $mode eq 'edit' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Editor/; + $HTML .= qq {

\n}; + + $script = < + + +EOM + $script =~ s/^\t{2}//gm; + $HTML =~ s/%SCRIPT%/$script/; + + $HTML .= "ã¹ã±ã¸ã¥ã¼ã«ç·¨éç»é¢ã§ãã
\n"; + $HTML .= "å®è£ãã¨ã¦ãé©å½ãªã®ã§ãå©ç¨ã«ã¯ç´°å¿ã®æ³¨æãæã£ã¦ãã ããã
\n
\n"; + if ( $id[0] ) { + @reserve = $dbh->selectrow_array( + "SELECT id, type, chtxt, title, btime, etime, deltaday, deltatime, opt + FROM rectime + WHERE id = $id[0]" + ); + $button_bgn = $button_end = ''; + } + else { + $reserve[1] = 'res'; + $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->strftime( '%Y-%m-%d %H:%M:%S' ); + $button_bgn = qq{\n
\n}; + $button_end = qq{}; + } + + if ( $q->param( 'suggest' ) eq 'auto' ) { + require Encode; + require Text::Ngram; + + my @btime = $reserve[4] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/; + my @etime = $reserve[5] =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/; + my $btime = DateTime->new( + year => $btime[0], month => $btime[1], day => $btime[2], + hour => $btime[3], minute => $btime[4], second => $btime[5], + ); + my $etime = DateTime->new( + year => $etime[0], month => $etime[1], day => $etime[2], + hour => $etime[3], minute => $etime[4], second => $etime[5], + ); + $btime_bgn = $btime->clone; + $btime_end = $btime->clone; + $etime_bgn = $etime->clone; + $etime_end = $etime->clone; + $btime_bgn->subtract( hours => $reserve[7] ); + $btime_end->add( hours => $reserve[7] ); + $etime_bgn->subtract( hours => $reserve[7] ); + $etime_end->add( hours => $reserve[7] ); + $btime_bgn = $btime_bgn->strftime( '%Y%m%d%H%M%S' ); + $btime_end = $btime_end->strftime( '%Y%m%d%H%M%S' ); + $etime_bgn = $etime_bgn->strftime( '%Y%m%d%H%M%S' ); + $etime_end = $etime_end->strftime( '%Y%m%d%H%M%S' ); + + my $ontv = $dbh->selectrow_array( "SELECT ontv FROM chdata WHERE chtxt = '$reserve[2]' " ); + $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop, title, exp + FROM tv + WHERE channel = '$ontv' + AND start BETWEEN '$btime_bgn' AND '$btime_end' + AND stop BETWEEN '$etime_bgn' AND '$etime_end' " + ); + + my %hash; + my $hash_r = Text::Ngram::ngram_counts( Encode::decode_utf8( $reserve[3] ), 2 ); # bi-gram + foreach my $program ( @{$ary_ref} ) { + my $hash_k = Text::Ngram::ngram_counts( Encode::decode_utf8( $program->[2] ), 2 ); + my $point; + map $point += $hash_k->{$_}, keys %{$hash_r}; + push @{$hash{$point}}, $program if ( $point ); + } + + $HTML .= qq {å¯è½æ§ã®ããçªçµ
\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + + foreach my $key (sort keys %hash){ + my $val = $hash{$key}; + foreach my $val ( @{$val} ) { + my $style = qq {style="white-space: nowrap"}; + $val->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/; + $val->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/; + $HTML .= qq {\n\n\n}; + $HTML .= qq {\n\n\n}; + $HTML .= qq {\n\n}; + } + } + $HTML .= qq {

åªååº¦	ã¿ã¤ãã«	éå§æå»	çµäºæå»	èª¬æ	é©ç¨
$key	$val->[2]	$val->[0]	$val->[1]	$val->[3]

\n
\n}; + } + + my $len = length $reserve[0]; + $HTML .= qq {

\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {ID\n\n}; + $HTML .= qq {ã¿ã¤ã\n\n}; + $HTML .= qq {ãã£ã³ãã«\n
\n}; + $HTML .= qq {ã¿ã¤ãã«\n
\n}; + $HTML .= qq {éå§æå»\n\n}.$button_bgn; + $HTML .= qq {çµäºæå»\n\n}.$button_end."
\n"; + $HTML .= qq {éæ¥å¨æ\n\n}; + $HTML .= qq {æå»èª¤å·®\n\n}; + $HTML .= qq {ãªãã·ã§ã³\n\n}; + $HTML .= qq {\n

\n}; +} + +if ( $mode eq 'change' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Change/; + $HTML .= qq {

\n}; + + if ( $q->param( 'delete' ) ) + { + if ( @id ) { + foreach my $id ( @id ) { + $dbh->do( "DELETE FROM rectime WHERE id = '$id'" ); + } + $HTML .= "åé¤ãã¾ããã
\n5ç§å¾ã«äºç´ç¢ºèªç»é¢ã«ç§»åãã¾ãã
\n"; + $HTML =~ s|%REFRESH%||; + goto end; + } + } + if ( $q->param( 'edit' ) ) + { + if ( $q->param( 'edit' ) eq 'ç·¨é(è¦JS)' ) { + $HTML .= "ã¹ã±ã¸ã¥ã¼ã«ç·¨éç»é¢ã«ç§»åãã¾ãã
\n"; + $HTML =~ s|%REFRESH%||; + goto end; + } + else { + goto end; + } + } + if ( $q->param( 'update' ) ) + { + $type = $q->param( 'type' ); + $chtxt = $q->param( 'ch' ); + $title = $q->param( 'title' ); + $begin = $q->param( 'begin' ); + $end = $q->param( 'end' ); + $deltaday = $q->param( 'deltaday' ); + $deltatime = $q->param( 'deltatime' ); + $opt = $q->param( 'opt' ); + $id = $id[0]; + if ( $id[0] ) { + $dbh->do( + "UPDATE rectime SET type = '$type', chtxt = '$chtxt', title = '$title', + btime = '$begin', etime = '$end', + deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt' + WHERE id = '$id'" + ); + } + else { + $dbh->do( + "INSERT INTO rectime ( type, chtxt, title, btime, etime, deltaday, deltatime, opt ) + VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt' )" + ); + } + $HTML .= "æ´æ°ãã¾ããã
\n5ç§å¾ã«äºç´ç¢ºèªç»é¢ã«ç§»åãã¾ãã
\n"; + $HTML =~ s|%REFRESH%||; + goto end; + } +} + +if ( $mode eq 'confirm' ) { + # && $display && $start && $stop + + $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/; + $HTML .= qq {

\n}; + &parse_program(); + + my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes; + $HTML .= "çªçµåï¼$title
\nãã£ã³ãã«ï¼$display
\næ¾éç¶ç¶æéï¼$durationå
\n"; + if ( &check_error() ) + { + # ã¨ã©ã¼ + + $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop FROM tv WHERE channel = '$channel' AND title = '$title' " + ); + $HTML .= "åä¸ã®çªçµã®ä»ã®æ¾éäºå®ã§ãã
\n"; + foreach my $line ( @{$ary_ref} ) { + $begin = $line->[0]; + $end = $line->[1]; + $begin =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/; + $end =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/; + $overlap = &get_overlap() >= 2 ? 'ä¸å¯è½' : + qq {å¯è½}; + $HTML .= "éå§ï¼$begin\nçµäºï¼$end\né²ç»ã¯$overlap
\n"; + } + } + else { + $desc = $dbh->selectrow_array( + "SELECT exp FROM tv WHERE channel = '$channel' AND start = '$start' AND stop = '$stop' " + ); + $selected_hd = $chtxt =~ /movieplus/ ? 'selected' : ''; + $selected_full = $chtxt =~ /\Qbs-nhk-hi\E/ ? 'selected' : ''; + $checked_anime = $chtxt =~ /animax|atx|disney|kids/ ? 'checked' : ''; + $checked_dual = $title =~ /\Q[äº]\E|ï¼»äºï¼½|\Q(äº)\E|ï¼äºï¼/ ? 'checked' : ''; + $checked_5_1 = $title =~ /5\.1|5ï¼1/ ? 'checked' : ''; + + $HTML .= "çªçµåå®¹ï¼$desc
\n
\né²ç»äºç´ã®è©³ç´°è¨å®ãè¡ã£ã¦ãã ããã
\n"; + $HTML .= qq {\n}; + } + goto end; +} + +if ( $mode eq 'reserve' ) { + $HTML .= qq {

\n}; + &parse_program(); + @opt = $q->param( 'opt' ); + $opt = join '', @opt; + if ( !&check_error ) { + $dbh->do( + "INSERT INTO rectime ( type, chtxt, title, btime, etime, opt ) + VALUES ( 'res', '$chtxt', '$title', '$begin', '$end', '$opt' )" + ); + } + $HTML .= "é²ç»äºç´ãå®è¡ãã¾ããã
\n5ç§å¾ã«ãããã¸ç§»åãã¾ãã
\n"; + $HTML =~ s|%REFRESH%||; + goto end; +} + +if ( $mode eq 'program' ) { + &draw_form(); + + $HTML =~ s/%HTML_TITLE_OPT%/ - Program Viewer/; + $unix = DateTime->now( time_zone => $tz )->strftime( '%Y%m%d%H%M%S' ); + $sql = + "SELECT tv.channel, + (SELECT display FROM ch WHERE ch.channel = tv.channel), + start, stop, title, category + FROM tv + INNER JOIN chdata ON tv.channel = chdata.ontv + WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start"; +# INNER JOIN ch ON tv.channel = ch.channel + + if ( $channel ) { + my $ch = "AND tv.channel = '$channel'"; + $sql =~ s/%CH%/$ch/; + } + if ( $date_sel ) { + $date_1 = $date_sel . '000000'; + $date_2 = Date::Simple->new( $date_sel =~ /(.{4})(.{2})(.{2})/ )->next->format('%Y%m%d') . '000000'; + my $date = "AND '$date_1' <= stop AND start <= '$date_2'"; + $sql =~ s/%DATE%/$date/; + } + if ( $category_sel ) { + # ä¸æç + $category_tmp = $category{$category_sel} . $category_sel; + my $category = "AND category = '$category_tmp'"; + $sql =~ s/%CATEGORY%/$category/; + } + if ( $key ) { + my $key = "AND TITLE LIKE '%$key%'"; + $sql =~ s/%KEY%/$key/; + } + $sql =~ s/%CH%//; + $sql =~ s/%DATE%//; + $sql =~ s/%KEY%//; + $sql =~ s/%CATEGORY%//; + + $ary_ref = $dbh->selectall_arrayref( $sql ); + foreach my $prg ( @{ $ary_ref } ) { + my @date = $prg->[2] =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/; + + $date = $date[2]; + if ( $date != $prev ) { + my $date = DateTime->new( + year => $date[0], month => $date[1], day => $date[2], +# hour => $date[3], minute => $date[4], second => $date[5], + locale => 'ja_JP' + ); + + my $dn = $date->day_name; + utf8::encode( $dn ); + $HTML .= qq {--------$date[1]/$date[2]($dn)--------
\n}; + } + $prg->[1] = $q->url_encode( $prg->[1] ); + $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] }; + $HTML .= qq {$prg->[4]
\n}; + $prev = $date; + } + +} + +if ( $mode eq 'list' ) { + require File::Find; + + $HTML =~ s/%HTML_TITLE_OPT%/ - List/; + + my $type = $q->param( 'type' ); + my $recording = $cfg->param( 'path.recpath' ); + my $recorded = $cfg->param( 'path.recorded' ); + + if ( !$type ) { + $HTML .= qq {é²ç»ä¸ã®ã¿\n}; + $HTML .= qq {é²ç»å¾ã®ã¿\n
\n}; + } + if ( !$type || $type eq 'new' ) { + $HTML .= "é²ç»ä¸ã®ãã¡ã¤ã«ä¸è¦§
\n"; + &list( $recording ); + } + if ( !$type ) { + $HTML .= "
\n"; + } + if ( !$type || $type eq 'old' ) { + $HTML .= "é²ç»å¾ã®ãã¡ã¤ã«ä¸è¦§
\n"; + &simple_list( $recorded ); + } + + sub list { + local $path = shift; + local %list = (); + my @exp = ( 'log', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log', + 'sa.avi', 'sa.avi.log', 'm2v', 'wav', 'avi', 'mkv' ); + for ( 0..$#exp ) { + $exp{$exp[$_]} = $_; + } + my $exp_count = scalar keys %exp; + + File::Find::find( \&wanted, $path ); + + foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) { + $HTML .= $exp{$name} + 1 . " = $name / "; + } + $HTML .= $exp_count+1 . qq { = ãµã ãã¤ã«
\nâ = å®äº / â = æ¸ãè¾¼ã¿ä¸
\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n} for ( 1..$exp_count + 1 ); + $HTML .= qq {\n}; + $HTML .= qq {\n}; + + foreach ( sort keys %list ) { + my $value = $list{$_}; + my @flag = ( 0 ) x $exp_count; + $HTML .= qq {\n\n}; + foreach ( keys %{$value} ) { + my $tmp = $_; + $flag[$exp{$tmp}] = $value->{$_}; + } + foreach ( @flag ) { + my $size = $_->{size}; + my $last = $_->{last} || 'â'; + my $check = $size ? qq {$last} : '
'; + $HTML .= qq {\n}; + } + if ( $flag[$exp{mkv}] ) { + s/#/ï¼/g; + s/ /\+/g; + my $img = $value->{mkv}->{img}; + $HTML .= qq {\n}; + my $pre = qq {äºæ¸¬}; + $HTML .= qq {\n}; +# my $exe = qq {å®è¡}; + my $exe = qq {å®è¡}; + $HTML .= qq {\n}; + } + else { + $HTML .= qq {\n\n}; + } + $HTML .= qq {\n}; + } + $HTML .= qq {

ã¿ã¤ãã«	$_	èªåç§»å
$_	$check	â	$pre	$exe

\n}; + + sub wanted { + return if ( !$_ ); + return if ( -d $File::Find::name ); + return if ( $_ eq 'Thumbs.db' ); + return if ( /\.idx/ ); + s/\.temp$//; + my $regexp = join '|', keys %exp; + my ( $title, $exp ) = /(.*?)\.($regexp)$/; + my ( $size, $last ) = &get_size( $File::Find::name ); + my $img; + $File::Find::name =~ s/\.temp$//; + if ( $title !~ /[^0-9A-F]/ ) { + $title = pack( 'H*', $title ); + $title = 'Base16_'.$title; + } + if ( $_ =~ /mkv/ ) { + my $tmp = $title; + $tmp =~ s/#/ï¼/g; + $tmp =~ s/ /\+/g; + $img = $tmp; +# $img = qq {

\n}; + } + die $_ if ( !$title ); + $list{$title}->{$exp} = { 'last' => $last, 'size' => $size, 'img' => $img }; + } + } + + sub simple_list { + local $path = shift; + local @list = (); + + File::Find::find( \&simple_wanted, $path ); + + @list = sort @list; + foreach ( @list ) { + $HTML .= "$_
\n"; + } + + sub simple_wanted { + return if ( !$_ ); + return if ( -d $File::Find::name ); + return if ( $_ eq 'Thumbs.db' ); + my ( $size ) = &get_size( $File::Find::name ); + $File::Find::name =~ s/\Q$path\E//; + push @list, $File::Find::name ."\t\t". $size; + } + } + + sub get_size { + my $file = shift; + my ( $size, $last ) = (stat( $file ))[7,9]; + my @unim = ("B","KB","MB","GB","TB","PB"); + my $count = 0; + + while($size >= 1024 ){ + $count++; + $size = $size / 1024; + } + $size *= 100; + $size = int( $size ); + $size /= 100; + if ( time - $last < 10 ) { + $last = 'â'; + } + else { + $last = ''; + } + return ( "$size $unim[$count]", $last ); + } +} + +if ( $mode eq 'move' ) { + my $type = $q->param( 'type' ); + my $title = $q->param( 'title' ); + $title =~ s/ï¼/#/g; + $title =~ s/\+/ /g; + + if ( $type eq 'predict' ) { + eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "classify.py -s '$title'`"; + } + elsif ( $type eq 'exec' ) { + eval '$HTML .= `python26 ' . $cfg->param( 'path.rec10' ) . "classify.py -e '$title'`"; + } +} + +if ( $mode eq 'thumb' ) { + my $title = $q->param( 'title' ); + my $pos = $q->param( 'pos' ); + my $recording = $cfg->param( 'path.recpath' ); + $title =~ s/\+/ /g; + $title =~ s/ï¼/#/g; + + print "Content-Type: image/jpeg\n\n"; + exec "ffmpeg -ss 300 -i '$recording/$title.mkv' -f image2 -pix_fmt jpg -vframes 1 -s 320x240 -"; + exit; +} + +if ( $mode eq 'check' ) { +} + +if ( $mode eq 'expert' ) { + my $ary_ref; + my $type = $q->param( 'type' ); + $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/; + $HTML .= qq {

\n}; + + if ( $type eq 'reget' ) { + my $display = $q->param( 'ch' ); + my $SQL_WHERE; + if ( $display =~ /^bs$|^cs.$/ ) { + $SQL_WHERE = "chdata.bctype = '$display'"; + } + else { + $SQL_WHERE = "display = '$display'"; + } + my $ontv = $dbh->selectrow_array( + "SELECT ontv FROM ch + INNER JOIN chdata ON ch.channel = chdata.ontv + WHERE $SQL_WHERE " ); + $dbh->do( "UPDATE chdata SET status = '2' WHERE ontv = '$ontv' " ); + goto end; + } + + + $ary_ref = $dbh->selectcol_arrayref( + "SELECT DISTINCT category FROM tv" + ); + # ä¸æç + my @category = map { $category{$_} . $_ } sort keys %category; + # my @category = sort keys %category; + $HTML .= qq {

\nçªçµè¡¨ã®ã«ãã´ãªä¸è¦§ã¨åèµã®ä¸è¦§ã®åè´ãç¢ºèªä¸...\n}; + # $HTML .= qq {çªçµè¡¨ï¼@{$ary_ref}
\nåèµï¼@category
\n}; + if ( List::Compare->new( $ary_ref, \@category )->get_symdiff ) { + $HTML .= qq {ä¸è´ãã¾ãã
\n}; + } + else { + $HTML .= qq {ä¸è´ãã¾ãã
\n}; + } + + my @ary = $dbh->selectrow_array( "SELECT terec, bscsrec, b252ts, ts2avi FROM status" ); + $HTML .= qq {

\nå°ä¸æ³¢é²ç»æ°ï¼$ary[0]\nè¡ææ³¢é²ç»æ°ï¼$ary[1]\nè§£èªæ°ï¼$ary[2]\nç¸ææ°ï¼$ary[3]\n
\n}; + + use List::Compare; + $ary_ref = $dbh->selectall_arrayref( "SELECT display, channel FROM ch INNER JOIN chdata ON ch.channel = chdata.ontv" ); + my $prev; + $HTML .= "

\nçªçµè¡¨ã®æ¬ è½
\n"; + foreach my $line ( @{$ary_ref} ) { + my $ary_ref = $dbh->selectall_arrayref( "SELECT start, stop, title FROM tv WHERE channel = '$line->[1]' ORDER BY start" ); + my $error; + my @program_old = ( '', $ary_ref->[0]->[0] ); + my $program_old = \@program_old; + + foreach my $program_new ( @{$ary_ref} ) { + if ( $program_old->[1] ne $program_new->[0] && + $program_old->[2] !~ /ã¯ãâã¸ã³ã°|ã¯ãã¼ã¸ã³ã°|ã¨ã³ãã£ã³ã°|ä¼æ¢|ããããã¤ããã¬ã¼ã³ã/ && + $program_new->[2] !~ /ãªã¼ããã³ã°|ã¦ã£ã¼ã¯ãªã¼ã»ã¤ã³ãã©ã¡ã¼ã·ã§ã³|ã¢ã¼ãã³ã°ãã¬ã¼ã³ã/ && + ( str2datetime( $program_new->[0], 1 ) - str2datetime( $program_old->[1], 1 ) )->delta_minutes > 30 ) { + $program_old->[1] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/; + $program_new->[0] =~ s/(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/$1-$2-$3 $4:$5:$6/; + $error .= qq{ $program_old->[2] $program_old->[1]\n ã $program_new->[2] $program_new->[0]\n}; + } + $program_old = $program_new; + } + $HTML .= qq {

\n$line->[0]\n$error

\n} if ( $error ); + } + + $ary_ref = $dbh->selectall_arrayref( + "SELECT display, chtxt, ontv, chdata.bctype, ch, csch, updatetime, status FROM chdata + INNER JOIN ch ON ch.channel = chdata.ontv + ORDER BY bctype " ); + $HTML .= qq {

\nçªçµè¡¨ã®æ´æ°ç¶æ³
\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + foreach my $status ( @{$ary_ref} ) { + $HTML .= qq {\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n}; + } + $HTML .= qq {

ãã£ã³ãã«å	ãã£ã³ãã«ã³ã¼ã	ontvã³ã¼ã	ã¿ã¤ã	ch	csch	æçµæ´æ°æå»	ç¶æ
$status->[0]	$status->[1]	$status->[2]	$status->[3]	$status->[4]	$status->[5]	$status->[6]	$status->[7]

\n}; + + $HTML .= qq {\n}; + + + + $ary_ref = $dbh->selectall_arrayref( + "SELECT id, type, rectime.chtxt, title, btime, etime, deltaday, deltatime + FROM rectime + ORDER BY id "); + $HTML .= qq {

\näºç´è¡¨
\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + foreach my $status ( @{$ary_ref} ) { + $HTML .= qq {\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n}; + } + $HTML .= qq {

ID	type	chtxt	title	btime	etime	deltaday	deltatime
$status->[0]	$status->[1]	$status->[2]	$status->[3]	$status->[4]	$status->[5]	$status->[6]	$status->[7]

\n}; +} + +if ( $mode eq 'help' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Help/; + $HTML =~ s|%REFRESH%||; + $HTML .= qq {

\n}; + $HTML .= qq {ãã«ã\n}; +} + +if ( $mode eq 'test' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Test/; + $HTML =~ s|%REFRESH%||; + $HTML .= qq {

\n}; + + require Data::Dumper; + require Perl6::Slurp; + $tmp = Perl6::Slurp::slurp( 'config.ini' ); + $tmp =~ s/\n/
\n/gs; + $HTML .= $tmp; + + # $HTML .= Dumper( $ary_ref ); +} + +if ( !$mode ) { + &draw_form(); + $HTML =~ s/%HTML_TITLE_OPT%/ - Top/; + $HTML .= qq {Welcome to Rec10!
\n}; + goto end; +} + + +end: +#

+$HTML .= < + + +EOM + +#

+$HTML_ADV_TEXT = < + + +EOM + +$HTML_ADV_IMG = < + + +EOM + +#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV ); +$HTML_HEADER = qq {

\n$HTML_ADV\n

\n}; + +&draw_menu(); +$HTML =~ s/%HTML_TITLE_OPT%//; +$HTML =~ s/%REFRESH%//; +$HTML =~ s/%SCRIPT%//; +$HTML =~ s/%CSS%//; +$HTML =~ s/%HTML_HEADER%/$HTML_HEADER/; + +print $HTTP_HEADER; +print $HTML; + +sub draw_menu { + $hires = Time::HiRes::time() - $hires; + $last_modified = localtime((stat 'rectool.pl')[9]); + + $HTML_HEADER .= qq {

\n}; + $HTML_HEADER .= qq {Last-Modified: $last_modified
Time-Elasped: $hiresç§\n}; + $HTML_HEADER .= qq {\n}; + $HTML_HEADER .= qq {ããã\n}; + $HTML_HEADER .= qq {äºç´ç¢ºèª\n}; + $HTML_HEADER .= qq {äºç´ç¶æ³(ç»åç)\n}; + $HTML_HEADER .= qq {é²ç»ä¸è¦§\n}; +# $HTML_HEADER .= qq {æ°è¦äºç´\n}; + $HTML_HEADER .= qq {æ°è¦äºç´\n}; + $HTML_HEADER .= qq {\n}; + $HTML_HEADER .= qq {

\n}; + $HTML_HEADER .= qq {

\n}; +} + +sub draw_form { + $channel = $dbh->selectrow_array("SELECT channel FROM ch WHERE display = '$display' "); + + # ãã£ã³ãã«æå® + $HTML .= qq {

\n}; + $HTML .= qq {

\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + + # æ¥ä»æå® + $HTML .= qq {\n}; + + # ã«ãã´ãªæå® + $HTML .= qq {\n}; + + # ãã¼ã¯ã¼ãæå® + $HTML .= qq {\n}; + + # ãã©ã¼ã æç» + $HTML .= qq {\n

\n}; +} + +sub parse_program { + @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/; + @stop = $stop =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/; + $channel = $dbh->selectrow_array("SELECT channel FROM ch WHERE display = '$display'"); + $title = $dbh->selectrow_array("SELECT title FROM tv WHERE channel = '$channel' AND start = '$start' AND stop = '$stop' "); + $chtxt = $dbh->selectrow_array("SELECT chtxt FROM chdata WHERE ontv = '$channel'"); + $bctype = $dbh->selectrow_array("SELECT bctype FROM chdata WHERE ontv = '$channel'"); + if ( $bctype =~ /.s/ ) { + $bctype = '_s%'; + } + elsif ( $bctype =~ /te/ ) { + $bctype = 'te%'; + } + $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' ); + $end = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' ); +} + +sub check_error { + my $is_error = 1; + my @overlap = &get_overlap(); + + if ( $dbh->selectrow_array( + "SELECT COUNT(*) FROM rectime + WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'" + ) ) { + $HTML .= "åä¸ã®çªçµãæ¢ã«åå¨ãã¾ãã
\n"; + } + elsif ( $overlap[0] >= 2 ) { + $HTML .= "æéãè¢«ãçªçµãæ¢ã«2ååå¨ãã¾ãã
\n"; + $HTML .= $overlap[1]; + } + else { + $is_error = 0; + } + return $is_error; +} + +sub get_overlap { + require List::Util; + + my $ary_ref = $dbh->selectall_arrayref( + "SELECT btime, etime, title + FROM rectime + INNER JOIN chdata ON rectime.chtxt = chdata.chtxt + WHERE bctype LIKE '$bctype' AND type IN ( 'rec', 'res', 'key', 'keyevery', 'tsrecording' ) + AND btime < '$end' + AND etime > '$begin' + " + ); + + my %overlap; + my $overlap = $max = 0; + my $str; + foreach my $prg ( @{ $ary_ref } ) { + $str .= "$prg->[0] ã $prg->[1] : $prg->[2]
\n"; + $overlap{$prg->[0]} += 1; + $overlap{$prg->[1]} -= 1; + } + foreach my $key ( sort keys %overlap ) { + $overlap += $overlap{$key}; + $max = List::Util::max( $max, $overlap ); + } + if ( wantarray ) { + return ( $max, $str ); + } + else { + return $max; + } +} + +sub str2datetime { + my $str = shift; + my $joined = shift; + my @time; + + if ( $joined ) { + @time = $str =~ /(.{4})(.{2})(.{2})(.{2})(.{2})(.{2})/; + } + else { + @time = $str =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/; + } + return DateTime->new( + year => $time[0], month => $time[1], day => $time[2], + hour => $time[3], minute => $time[4], second => $time[5], + ); +} + -- 2.11.0