Rec10%HTML_TITLE

\n}; - - if ( $rec10_version > $rectool_version ) { - $HTML .= qq {Rec10æ¬ä½ã®ãã¼ã¸ã§ã³ãæ°ãããããå®è¡ã§ãã¾ããã
\n}; - $HTML .= qq {rectoolã®ãã¼ã¸ã§ã³ã¢ãããè¡ã£ã¦ãã ããã
\n}; - } - - if ( $rec10_version < $rectool_version ) { - $HTML .= qq {Rec10æ¬ä½ã®ãã¼ã¸ã§ã³ãå¤ããããå®è¡ã§ãã¾ããã
\n}; - $HTML .= qq {Rec10ã®ãã¼ã¸ã§ã³ã¢ãããè¡ã£ã¦ãã ããã
\n}; - } - - $HTML .= qq {Rec10ã®ãã¼ã¸ã§ã³ã¯$rec10_version ãrectoolã®ãã¼ã¸ã§ã³ã¯$rectool_version ã§ãã
\n}; - $HTML .= qq {å¬å¼ãã¼ã¸\n}; - goto end; -} - -$q = new CGI; -%params = $q->Vars; -$mode = $params{ 'mode' }; -$mode_sub = $params{ 'mode_sub' }; - -################ %chtxt_chnameã®æºå ################ - -my %chtxt_chname; -my %chtxt_0_chname; -tie %chtxt_0_chname, 'Tie::IxHash'; - -my $ary_ref = $dbh->selectall_arrayref( - "SELECT chtxt, chname, ch, bctype FROM epg_ch - WHERE visible = 1" -); - -%chtxt_chname = map { $_->[0], $_->[1] } @{$ary_ref}; - -# NHK BS 1/2/hiãBS/CSããé¤å¤(101-103) - by 2011/04 -# te: å°ä¸æ³¢ãBSã®NHKä»¥å¤ -# bc: BSã®NHKãCS -my @te_ary = grep $_->[0]=~ /^\d|BS_(?!(10|19)[1-3])/, @{$ary_ref}; -my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!(10|19)[1-3])/, @{$ary_ref}; - -# teã®æä½(ã¾ã¨ãã) -foreach my $line ( @te_ary ) { - # te xx_yyyy(chtxt) -> xx(ch) - if ( $line->[3] =~ /te/ ) { - push @{ $chtxt_0_chname{ $line->[2] . '_0'} }, $line->[1]; - } - else { - push @{ $chtxt_0_chname{'BS_' . $line->[2] } }, $line->[1]; - } -} -foreach my $key ( keys %chtxt_0_chname ) { - my @chname = @{ $chtxt_0_chname{$key} }; - if ( @chname >= 2 ) { - # 2ã¤ä»¥ä¸ããå ´å - my @tmp = map { my @ary = split //, $_; \@ary } @chname; - # 1ã¤ç®ã¨2ã¤ç®ã®ã¿æ¯è¼ - # FIXME: ãã¹ã¦ãæ¯è¼ããã¹ã - $chtxt_0_chname{$key} = join '', LCS( $tmp[0], $tmp[1] ); - } - else { - # 1ã¤ãããªãå ´å - $chtxt_0_chname{$key} = $chname[0]; - } -} - -# bs/csã®æä½(ãã®ã¾ã¾) -foreach my $line ( @bc_ary ) { - $chtxt_0_chname{$line->[0]} = $line->[1]; -} -undef $ary_ref; - - -################ å®æ°å®£è¨ ################ - - -tie %type, 'Tie::IxHash'; -%type = ( - 'search_everyday' => 'éæ¥æ¤ç´¢', - 'search_today' => 'å½æ¥æ¤ç´¢', - 'reserve_flexible' => 'æµ®åäºç´', - 'reserve_fixed' => 'ç¢ºå®äºç´', - - 'reserve_running' => 'é²ç»éä¸', - - 'convert_b25_ts' => 'è§£èªäºç´', - 'convert_b25_ts_running' => 'è§£èªéä¸', - 'convert_b25_ts_miss' => 'è§£èªå¤±æ', - - 'convert_ts_mp4' => 'ç¸æäºç´', - 'convert_ts_mp4_running' => 'ç¸ææ¼é¯', - 'convert_ts_mp4_network' => 'ç¸ææ¼ç¶²', - 'convert_ts_mp4_finished' => 'ç¸æå®äº', - - 'convert_avi_mkv' => 'å¤ææ§é²', - 'convert_avi_mp4' => 'å¤ææ§å', - 'convert_mkv_mp4' => 'å¤æé²å', - 'convert_mkv_mp4_runnings' => 'æéé²å', - - 'auto_suggest_dec' => 'äºæ¸¬è§£èª', - 'auto_suggest_enc' => 'äºæ¸¬ç¸æ', - 'auto_suggest_avi2fp' => 'äºæ¸¬æ§å', - 'auto_suggest_ap2fp' => 'äºæ¸¬é²å', - - 'move_end' => 'ç§»åå®äº', -); - -%type_suggest = ( - 'auto_suggest_dec' => 'convert_b25_ts', - 'auto_suggest_enc' => 'convert_ts_mp4', - 'auto_suggest_avi2fp' => 'convert_avi_mkv', - 'auto_suggest_ap2fp' => 'convert_mp4_mkv', -); - -%color = ( - 'search_everyday' => '#8B008B', - 'search_today' => '#8B008B', - 'reserve_flexible' => '#4169E1', - 'reserve_fixed' => '#4169E1', - 'reserve_running' => '#FF8C00', - 'convert_b25_ts' => '#CD5C5C', - 'convert_b25_ts_running' => '#DC143C', - 'convert_ts_mp4' => '#32CD32', - 'convert_ts_mp4_running' => '#2E8B57', - 'convert_ts_mp4_network' => '#808000', - - 'other' => '#A0A0A0', -); - -$type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )"; - -tie %category, 'Tie::IxHash'; -%category = ( - 'news' => { name => 'ãã¥ã¼ã¹ã»å ±é' , color => '#ff0000' }, - 'sports' => { name => 'ã¹ãã¼ã' , color => '#ff8000' }, - 'information' => { name => 'æå ±' , color => '#ffff00' }, - 'drama' => { name => 'ãã©ã' , color => '#80ff00' }, - 'music' => { name => 'é³æ¥½' , color => '#00ff00' }, - 'variety' => { name => 'ãã©ã¨ãã£' , color => '#00ff80' }, - 'cinema' => { name => 'æ ç»' , color => '#00ffff' }, - 'anime' => { name => 'ã¢ãã¡ã»ç¹æ®' , color => '#0080ff' }, - 'documentary' => { name => 'ããã¥ã¡ã³ã¿ãªã¼ã»æé¤' , color => '#0000ff' }, - 'stage' => { name => 'æ¼å' , color => '#8000ff' }, - 'hobby' => { name => 'è¶£å³ã»å®ç¨' , color => '#ff00ff' }, - 'etc' => { name => 'ãã®ä»' , color => '#ff0080' }, -); - -################ åæåããã¾ã§ ################ - - -################ mode=schedule ################ - -if ( $mode eq 'schedule' ) { - - $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/; - #$HTML =~ s|%REFRESH%||; - $css = < - td { - white-space: nowrap; - } - -EOM - $css =~ s/^\t{2}//gm; - $HTML =~ s/%CSS%/$css/; - - my $order = $params{ 'order' }; - my $extra = $params{ 'extra' }; - if ( $order ne 'id' ) { - $order = 'btime'; - } - $reverse_extra = $extra ? '' : '&extra=1'; - $forward_order = $order eq 'btime' ? '' : '&order=id'; - - my $ary_ref = $dbh->selectall_arrayref( - "SELECT id, type, timeline.chtxt, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime, - epgtitle, epgbtime, epgetime, epgexp, epgduplicate, epgchange, counter - FROM timeline - LEFT OUTER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt - ORDER BY $order" - , {Slice=>{}}); - - $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}; - $HTML .= qq {\n}; - foreach my $line ( @{ $ary_ref } ) { - - $type = $type{$line->{type}} || $line->{type}; - if ( $line->{type} =~ /^search/ ) { - $type = qq {$type}; - $line->{deltaday} = qq {ç©º} if ( !$line->{deltaday} && $line->{type} eq 'search_everyday' ); - $line->{deltatime} = qq {ç©º} if ( !$line->{deltatime} ); - } - else { - my $color = $color{$line->{type}} ? $color{$line->{type}} : $color{'other'}; - $type = qq {$type}; - } - # å°ä¸æ³¢ã®å ´åãxx_yyyãxx_0ã«ç½®æãã - ( $line->{chtxt_0} = $line->{chtxt} ) =~ s/(\d+)_/$1_0/; - # chnameãç¡ãã¨ã(ç§»åç¸æãªã©)ãchtxtãä»£ããã«ä½¿ã - $line->{chname} = - $line->{chname} || - $chtxt_0_chname{$line->{chtxt}} || - $chtxt_0_chname{$line->{chtxt_0}}; - if ( !$line->{chname} ) { - # chnameãç¡ãã¨ãããªã³ã¯ãä½æããªã - $line->{chname} = $line->{chtxt}; - $line->{chname_link} = qq {$line->{chname}}; - } - else { - $line->{chname_link} = qq {$line->{chname}}; - } - $line->{title} = 'ã¿ã¤ãã«ãªã' if ( !$line->{title} ); - $line->{tr_style} = ''; - $line->{title_2} = ''; - my $unix_b = str2datetime( $line->{btime} ); - my $unix_e = str2datetime( $line->{etime} ); - - my $btime = $unix_b->strftime( '%Y%m%d%H%M%S' ); - my $etime = $unix_e->strftime( '%Y%m%d%H%M%S' ); - if ( $extra and $line->{type} =~ /^search_|^reserve_(?!running)/ ) { - #my @ary = $dbh->selectrow_array( - # "SELECT title, exp FROM epg_timeline - # WHERE channel = '$line->{chname}' - # AND start = '$btime' - # AND stop = '$etime' "); - #my @ary = ( $line->{epgtitle}, $line->{epgexp} ); - my ( $epgtitle, $epgexp ) = ( $line->{epgtitle}, $line->{epgexp} ); - - if ( $epgtitle ) { - $epgtitle =~ s/ç¡æâ«//; - - if ( $epgtitle ne $line->{title} ) { - # epgtitleã¨titleãä¸è´ããªã - # []ã«å²ã¾ããé¨åãé¤å»ãã¦æ¯è¼ - my @brackets = $line->{title} =~ /(\[.+\])+/; - my $epgtitle_nobrackets = $epgtitle; - my $title_nobrackets = $line->{title}; - if ( @brackets && $epgtitle =~ /(\[.+\])+/ >= @brackets ) { - foreach ( @brackets ) { - $epgtitle_nobrackets =~ s/\Q$_\E//; - } - } - $title_nobrackets =~ s/(\[.+\])+//; - if ( !scalar $epgtitle_nobrackets =~ s/\Q$title_nobrackets\E// ) { - # epgtitleã«titleãå«ã¾ãã¦ããªã - my $href = qq {èªåæ¤ç´¢}; - $epgtitle = qq {$epgtitleâ $hrefâ }; - } - else { - # epgtitleã«titleãå«ã¾ãã¦ãã - $epgtitle = $epgtitle_nobrackets; - } - } - else { - # epgtitleã¨titleãä¸è´ãã¦ãã - $epgtitle = 'èª¬æ'; - } - - $line->{title_2} = qq {

$epgtitle

}; - } - else { - # epgtitleããªã - my $href = qq {èªåæ¤ç´¢}; - $line->{title_2} = qq {â $hrefâ }; - $line->{tr_style} = qq {style="background-color: #A0A0A0"}; - } - } - - my ( $begin, $end, $diff ) = &str2readable( $unix_b, $unix_e ); - - my $hr = ''; - if ( - $line->{type} eq 'reserve_running' - && - $unix_b->epoch <= time && time <= $unix_e->epoch - ) - { - $percent = int( ( 100 * ( time - $unix_b->epoch ) ) / ( $unix_e->epoch - $unix_b->epoch ) ); - $hr .= qq {

}; - } - - $line->{title} = qq {$line->{title}}; - #$line->{title} = qq {

$line->{title}

} if ( $line->{title_2} ); - $HTML .= qq {{tr_style}>\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\n}; - $HTML .= qq {\n}; - } - $HTML .= qq {

â	ID	ã¿ã¤ã	ãã£ã³ãã«	ã¿ã¤ãã«	éå§æå»	çµäºæå»	é²ç»æé	ãªãã·ã§ã³	dd	dt	æ®ã
	$line->{id}	$type	$line->{chname_link}	$line->{title}$line->{title_2}	$begin	$end	$hr$diff	$line->{opt}	$line->{deltaday}	$line->{deltatime}	$line->{counter}

\n}; - #$HTML .= qq {\n}; - $HTML .= qq {\n

\n}; - goto end; -} - -################ mode=graph ################ - -if ( $mode eq 'graph' ) { - - my $date = $params{ 'date' }; - - if ( $date ) - { - print "Content-Type: image/svg+xml\n\n"; - - require SVG; - $date = Date::Simple->new( split /-/, $date ); - $graph_bgn = $date->format('%Y-%m-%d'); - $graph_end = $date->next->format('%Y-%m-%d'); - $day = $date->day; - $today = $date eq Date::Simple->today() ? 1 : 0; - - $tuner{terrestrial} = $cfg->param( 'env.te_max' );# 2; - $tuner{satellite} = $cfg->param( 'env.bscs_max' );# 2; - $tuner{all} = $tuner{terrestrial} + $tuner{satellite}; - $hours = 24; - $width = 30 * $hours; - my %category_color = map { $_->{name}, $_->{color} } values %category; - - $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 be used 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->tag( 'line', x1 =>50, x2 => 50 + $width, y1 => $_ * 20 + 10, y2 => $_ * 20 + 10, -# style => { stroke => 'gray' } ); -# $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 ); - $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 14, width => $width, height => 2 ); - } - 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' } ); - } - my $ary_ref = $dbh->selectall_arrayref( - # epg_timeline.channel = timeline.chtxt && - "SELECT id, title, chtxt, btime, etime, epgcategory, opt FROM timeline - WHERE type IN $type_user_made - 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 btime" - , {Slice=>{}} - ); - - foreach my $bctype ( '\d+_', 'S_' ) { - my $tuner = $bctype eq '\d+_' ? $tuner{terrestrial} : $tuner{satellite}; - my @ary_ref = grep { $_->{chtxt} =~ /$bctype/ } @{ $ary_ref }; - my @y_drawn = ('') x $tuner; - foreach my $line ( @ary_ref ) { - @start = $line->{btime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/; - @stop = $line->{etime} =~ /(.{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->{btime}; - $end = $line->{etime}; - - my @ary = grep { ( $_->{etime} cmp $line->{btime} ) > 0 and ( $_->{btime} cmp $line->{etime} ) < 0 and $_->{id} != $line->{id} } @ary_ref; - foreach my $i ( 0..$tuner - 1 ) { - next if ( ( $y_drawn[$i] cmp $line->{btime} ) > 0 ); - #for ( 'chtxt', 'btime', 'etime' ) { - # $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} ); - #} - $line->{slot} = $i; - $y_drawn[$i] = $line->{etime}; - last; - } - my ( $r, $g, $b ) = ( 0, 0, 0 ); - $r += 255 if ( $line->{opt} =~ /a/ ); - $g += 255 if ( $line->{opt} =~ /H/ ); - $b += 255 if ( $line->{opt} =~ /I/ ); - 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->{id}", - target => '_blank', - -title => html_escape( $line->{title} ), - )->rectangle( - 'x' => 50 + $start, - 'y' => 30 + ( $bctype eq '\d+_' ? 0 : $tuner{terrestrial} * 20 ) + $line->{slot} * 20, - width => $stop - $start, - height => 10, - style => { fill => $category_color{$line->{epgcategory}} || $category_color{'ãã®ä»'} } ); - #style => { fill => "rgb($r,$g,$b)" } ); - } - } - my $xml = $svg->xmlify; - utf8::encode( $xml ); - print $xml; - #warningsToBrowser(true); - 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ãç¤ºãã¦ãã¾ãã
\n}; - $HTML .= qq {SVGãå©ç¨å¯è½ãªãã©ã¦ã¶ã§ãè¦§ãã ããã
\n}; - $HTML .= qq {è²ã¨ã¸ã£ã³ã«ã®å¯¾å¿\n}; - map { - $HTML .= qq {$_->{name}\n}; - } values %category; - $HTML .= qq {
\n}; - - $ary_ref = $dbh->selectcol_arrayref( - "SELECT DISTINCT DATE( btime ) - FROM timeline - WHERE type in $type_user_made - 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 timeline - 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; - } -} - -################ mode=atom ################ - -if ( $mode eq 'atom' ) { - require XML::Atom::Feed; - require XML::Atom::Entry; - - my $recording_count = $encoding_count = $jbk_count = 0; - my $ary_ref = $dbh->selectall_arrayref( - "SELECT chtxt, title, btime, etime, opt - FROM timeline - WHERE type = 'reserve_running' "); - foreach my $line ( @{$ary_ref} ) { - my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] ); - $recording_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]
\n}; - $recording_count++; - } - $ary_ref = $dbh->selectall_arrayref( - "SELECT chtxt, title, btime, etime, opt - FROM timeline - WHERE type = 'convert_ts_mp4_running' "); - foreach my $line ( @{$ary_ref} ) { - my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] ); - $encoding_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]
\n}; - $encoding_count++; - } - $ary_ref = $dbh->selectall_arrayref( - "SELECT id, chtxt, title, btime, etime - FROM auto_timeline_keyword " ); - foreach my $line ( @{$ary_ref} ) { - my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] ); - $jbk_status .= qq {$line->[0] $line->[1] $line->[2] $begin - $end $diff
\n}; - $jbk_count++; - } - - my $feed = XML::Atom::Feed->new( Version => 1.0 ); - $feed->title('Rec10 ãã£ã¼ã'); - - my $entry = XML::Atom::Entry->new( Version => 1.0 ); - $entry->title("Rec10 é²ç»ç¶æ³ ($recording_count)"); - $entry->id('tag:recording_status'); - $entry->content($recording_status); - $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) ); - $feed->add_entry($entry); - - $entry = XML::Atom::Entry->new( Version => 1.0 ); - $entry->title("Rec10 ç¸æç¶æ³ ($encoding_count)"); - $entry->id('tag:encoding_status'); - $entry->content($encoding_status); - $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) ); - $feed->add_entry($entry); - - $entry = XML::Atom::Entry->new( Version => 1.0 ); - $entry->title("Rec10 å°å¼ç¶æ³ ($jbk_count)"); - $entry->id('tag:jbk_status'); - $entry->content($jbk_status); - $entry->add_link(str_to_link( './rectool.pl?mode=jbk' ) ); - $feed->add_entry($entry); - - my $xml = $feed->as_xml; - print "Content-Type: application/atom+xml\n\n"; - print $xml; - exit; - - sub str_to_link { - my $link = XML::Atom::Link->new( Version => 1.0 ); - $link->type('text/html'); - $link->rel('alternate'); - $link->href(shift); - return $link; - } -} - -################ mode=edit ################ - -if ( $mode eq 'edit' ) { - my $id = $params{ 'id' }; - - $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 ) { - # äºç´ã®ç·¨é - &parse_program(); - $button_bgn = $button_end = ''; - } - else { - # æ°è¦äºç´ - $type = 'reserve_flexible'; - $counter = -1; - $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' ); - $button_bgn = qq{\n
\n}; - $button_end = - qq{} - .qq{} - .qq{}; - } - - if ( $params{ 'suggest' } eq 'auto' ) { - my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/; - my @etime = $end =~ /(.{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], - ); - my %hash = &sqlgetsuggested( $btime, $etime ); - - $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 $id; - $HTML .= qq {

\n}; - $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}; - $HTML .= $button_bgn; - $HTML .= qq {çµäºæå»\n\n}; - $HTML .= $button_end . "
\n"; - $HTML .= qq {éæ¥å¨æ\n\n}; - $HTML .= qq {æå»èª¤å·®\n\n}; - $HTML .= qq {ãªãã·ã§ã³\n\n}; - $HTML .= qq {åæ°\n\n}; - $HTML .= qq {\n

\n}; -} - -################ mode=change ################ - -if ( $mode eq 'change' ) { - @id = $q->param( 'id' ); - - $HTML =~ s/%HTML_TITLE_OPT%/ - Change/; - $HTML .= qq {

\n}; - - if ( $params{ 'delete' } ) - { - if ( @id ) { - foreach my $id ( @id ) { - $dbh->do( "DELETE FROM timeline WHERE id = '$id'" ); - } - $HTML .= "åé¤ãã¾ããã
\n5ç§å¾ã«äºç´ç¢ºèªç»é¢ã«ç§»åãã¾ãã
\n"; - $HTML =~ s|%REFRESH%||; - goto end; - } - } - if ( $params{ 'update' } ) - { - $type = $params{ 'type' }; - $chtxt = $params{ 'chtxt' }; - $title = $params{ 'title' }; - $begin = $params{ 'begin' }; - $end = $params{ 'end' }; - $deltaday = $params{ 'deltaday' }; - $deltatime = $params{ 'deltatime' }; - $opt = $params{ 'opt' }; - $counter = $params{ 'counter' }; - $id = $id[0]; - if ( $id ) { - $dbh->do( - "UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title', - btime = '$begin', etime = '$end', - deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt', counter = '$counter' - WHERE id = '$id'" - ); - } - else { - $dbh->do( - "INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter ) - VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt', '$counter' )" - ); - } - $HTML .= "æ´æ°ãã¾ããã
\n5ç§å¾ã«äºç´ç¢ºèªç»é¢ã«ç§»åãã¾ãã
\n"; - $HTML =~ s|%REFRESH%||; - goto end; - } - if ( $mode_sub eq 'proc' ) { - my $type = $params{ 'type' }; - my $chtxt = $params{ 'chtxt' } || 'nhk-k'; - my $title = $params{ 'title' }; - my @opt = $q->param( 'opt' ); - my $opt = join '', @opt; - - my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10); - my $sql_type = $type_suggest{$type}; - my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' ); - $datetime_now = $datetime_now->add( minutes => 60 ); - my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' ); - - $dbh->do( - "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt ) - VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )" - ); - - goto end; - } - if ( $mode_sub eq 'move' ) { - my $mode_sub2 = $params{ 'mode_sub2' }; - my $title = $params{ 'title' }; - my $response; - - $ENV{'LANG'} = 'ja_JP.UTF-8'; - if ( $mode_sub2 eq 'predict' ) { - $HTML .= "ç§»åå¾ã®ã·ãã¥ã¬ã¼ã·ã§ã³çµæã§ãã\n
"; - eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`"; - } - elsif ( $mode_sub2 eq 'exec' ) { - eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`"; - } - utf8::decode( $response ); - $HTML .= $response; - - goto end; - } - if ( $mode_sub eq 'setting' ) { - my $jbk = $params{ 'jbk' } || '0'; - my $bayes = $params{ 'bayes' } || '0'; - my $del_tmp = $params{ 'del_tmp' } || '0'; - my $opt = $params{ 'opt' } || ''; - my $user = $params{ 'user' } || ''; - my $pass = $params{ 'pass' } || ''; - - $dbh->do( - "UPDATE in_settings SET auto_jbk = '$jbk', auto_bayes = '$bayes', - auto_del_tmp = '$del_tmp', auto_opt = '$opt'" - ); - - goto end; - } - if ( $mode_sub eq 'fixstatus' ) { - my $key = $params{ 'terec' } ? 'terec' : $params{ 'bscsrec' } ? 'bscsrec' : - $params{ 'b252ts' } ? 'b252ts' : $params{ 'ts2avi' } ? 'ts2avi' : ''; - - $dbh->do( - "UPDATE in_status SET $key = 0" - ); - - goto end; - } - -} - -################ mode=confirm ################ - -if ( $mode eq 'confirm' ) { - if ( $mode_sub eq 'reserve' ) { - $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/; - $HTML .= qq {

\n}; - &parse_program(); - - my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes; - $HTML .= "çªçµåï¼$title
\nãã£ã³ãã«ï¼$chname
\næ¾éç¶ç¶æéï¼$duration å
\nçªçµåå®¹ï¼$desc
\nã¸ã£ã³ã«ï¼$category
\n"; - if ( $longdesc ) { - $longdesc =~ s/\\n/
\n/gs; - $HTML .= "çªçµåå®¹(é·)ï¼$longdesc
\n"; - } - my $error = &check_error(); - if ( $error ) - { - # ã¨ã©ã¼ - - $ary_ref = $dbh->selectall_arrayref( - "SELECT start, stop FROM epg_timeline WHERE channel = '$chtxt' AND title = '$title' " - ); - if ( $error != 1 ) { - $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 { - $HTML .= "é²ç»äºç´ã®è©³ç´°è¨å®ãè¡ã£ã¦ãã ããã
\n"; - $HTML .= qq {\n}; - } - goto end; - } - # End of $mode_sub eq 'reserve'; - - if ( $mode_sub eq 'proc' ) { - my $type = $params{ 'type' }; - local $chtxt = $params{ 'chtxt' }; - my $title = $params{ 'title' }; - local $opt = $params{ 'opt' }; - utf8::decode( $title ); - - $HTML .= "è©³ç´°è¨å®ãè¡ã£ã¦ãã ããã
\n"; - $HTML .= "ã¿ã¤ãã«ï¼$title\n
\n"; - - $HTML .= qq {\n}; - goto end; - } -} - -################ mode=reserve ################ - -if ( $mode eq 'reserve' ) { - $HTML .= qq {

\n}; - &parse_program(); - $title = $params{ 'title' } if ( !$title ); - @opt = $q->param( 'opt' ); - $opt = join '', @opt; - my ( $deltaday, $deltatime ); - - if ( $params{'every'} eq '1' ) { - $type = 'search_everyday'; - ( $changed_t ) = $title =~ /(.*)#/; - $title = $changed_t if ( $changed_t ); - ( $changed_t ) = $title =~ /(.*)ç¬¬/; - $title = $changed_t if ( $changed_t ); - ( $changed_t ) = $title =~ /(.*)â½/; - $title = $changed_t if ( $changed_t ); - $title =~ s/ã.*ã//; - $title =~ s/ï¼.*ï¼//; - $title =~ s/ï¼.*ï¼//; - $title =~ s/\[æ°\]//; - $title =~ s/ç¡æâ«//; - $title =~ s/\s*$//; - $deltaday = 7; - $deltatime = 3; - } - else { - $type = 'reserve_flexible'; - } - $chtxt = $chtxt_0 if ( $chtxt_0 ); - if ( !&check_error ) { - $dbh->do( - "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime ) - VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$opt', '$deltaday', '$deltatime' )" - ); - } - $HTML .= "é²ç»äºç´ãå®è¡ãã¾ããã
\n5ç§å¾ã«ãããã¸ç§»åãã¾ãã
\n"; - $HTML =~ s|%REFRESH%||; - goto end; -} - -################ mode=program ################ - -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 channel, epg_ch.chname, start, stop, title, category - FROM epg_timeline - INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.chtxt - WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start"; - - if ( $chtxt ) { - my $ch; - if ( $chtxt =~ /^\d+(_0)?$/ ) { - # teã¯xx_yyyå½¢å¼ã§ãããã - $chtxt =~ s/_0//; - $ch = "AND channel LIKE '$chtxt\_%'"; - } - else { - $ch = "AND channel = '$chtxt'"; - } - $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{$category_sel}->{name}'"; - $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], - locale => 'ja_JP' - ); - - my $dn = $date->day_name; - #utf8::encode( $dn ); - $HTML .= qq {--------$date[1]/$date[2]($dn)--------
\n}; - } - $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] }; - $HTML .= qq {$prg->[1] } if ( !$chtxt ); - $HTML .= qq {$prg->[4]
\n}; - $prev = $date; - } -} - -################ mode=list ################ - -if ( $mode eq 'list' ) { - $HTML =~ s/%HTML_TITLE_OPT%/ - List/; - $HTML .= qq {

\n}; - - my $recording = $cfg->param( 'path.recpath' ); - my $ts_movepath = $cfg->param( 'path.ts_movepath' ); - my $recorded = $cfg->param( 'path.recorded' ); - - if ( $mode_sub eq 'log' ) { - my $title = $params{ 'title' }; - my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" ); - utf8::decode( $log ); - $HTML .= '

'.$log."

\n"; - goto end; - } - if ( $mode_sub eq 'logzip' ) { - my $title = $params{ 'title' }; - my $zip = Archive::Zip->new(); - my $logzip; - die 'read error' unless $zip->read("$recording/$title.log.zip") == AZ_OK; - my @members = $zip->members(); - foreach (@members) { - $logzip .= $_->fileName() . "\n"; - my @lines = split /\n|\r/, $zip->contents( $_->fileName() ); - my %count; - @lines = grep {!$count{$_}++} @lines; - $logzip .= join "\n", @lines; - $logzip .= "\n\n"; - } - - utf8::decode( $logzip ); - $HTML .= '

'.$logzip."

\n"; - goto end; - } - if ( !$mode_sub ) { - $HTML .= qq {é²ç»ä¸ã®ã¿\n}; - $HTML .= qq {é²ç»å¾ã®ã¿\n
\n}; - } - if ( !$mode_sub || $mode_sub eq 'new' ) { - $HTML .= "é²ç»ä¸ã®ãã¡ã¤ã«ä¸è¦§
\n"; - &list( $recording ); - } - if ( !$mode_sub ) { - $HTML .= "
\n"; - } - if ( !$mode_sub || $mode_sub eq 'old' ) { - $HTML .= "é²ç»å¾ã®ãã¡ã¤ã«ä¸è¦§
\n"; - &simple_list( $ts_movepath ); - &simple_list( $recorded ); - } - - sub list { - local $path = shift; - local %list = (); - my @exp = ( 'log', 'log.zip', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log', - 'aac', 'srt', 'm2v', 'wav', '264', 'mp4', 'mkv' ); - for ( 0..$#exp ) { - $exp{$exp[$_]} = $_; - } - my $exp_count = scalar keys %exp; - - &get_file_list_wrapper( $path, \&wanted ); - - my $help; - foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) { - $help .= $exp{$name} + 1 . " = $name / "; - } - $HTML .= $help; - $help = qq {$help\n\n}; - $help .= qq {$_\n} for ( 1..$exp_count ); - - $HTML .= qq {
\nâ = å®äº / â = æ¸ãè¾¼ã¿ä¸ / â = ãã¡ã¤ã«ãµã¤ãºç°å¸¸
\n}; - $HTML .= qq {\n\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n} for ( 1..$exp_count ); - $HTML .= qq {\n}; - - my $count = 0; - - foreach my $title ( sort keys %list ) { - my $value = $list{$title}; - my @flag = ( 0 ) x ( $exp_count ); - $HTML .= qq {\n\n}; - foreach my $exp ( keys %{$value} ) { - if ( $exp eq 'log' ) { - # ãã°ã¸ã®ãªã³ã¯ãè¿½å - my $title = $q->escape( $title ); - my $extra = qq {\n}; - - $value->{$exp}->{extra} = $extra; - } - elsif ( $exp eq 'log.zip' ) { - # ZIPãã°ã¸ã®ãªã³ã¯ãè¿½å - my $title = $q->escape( $title ); - my $extra = qq {\n}; - - $value->{$exp}->{extra} = $extra; - } - elsif ( $exp eq 'mp4' ) { - # âãªã©ã®ä»£ããã«ãµã¤ãºãè¡¨ç¤º - $value->{$exp}->{style} = $value->{$exp}->{size}; - } - elsif ( $exp eq 'mkv' ) { - # ãµã ãã¤ã«ã¸ã®ãªã³ã¯ãè¿½å - my $title = $q->escape( $title ); - - my $extra = qq {\n}; - $value->{$exp}->{extra} = $extra; - } - $flag[$exp{$exp}] = $value->{$exp}; - } - foreach ( @flag ) { - my $size = $_->{size}; - my $style = $_->{style}; - my $span = $size ? qq {$style} : '
'; - $HTML .= $_->{extra} || qq {\n}; - } - $HTML .= qq {\n}; - $HTML .= $help unless ( ++$count % 20 ); - } - $HTML .= qq {

ã¿ã¤ãã«	$_
$title	â	â	â	$span

\n}; - - sub wanted { - my $rel = shift; - my $abs = shift; - - return if ( $rel =~ /Thumbs\.db/ ); - return if ( $rel =~ /\.idx/ ); - - $rel =~ s/\.temp$//; - my $regexp = join '|', keys %exp; - my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/; - my ( $size, $style ) = &get_size( $abs ); - $rel =~ s/\.temp$//; - if ( !$title ) { - $title = '_error_exp_'.$rel; - $exp = 'log'; - } - if ( $title !~ /[^0-9A-F]+/ ) { - my $tmp = pack( 'H*', $title ); - if ( !$tmp ) { - $title = '_error_b16_'.$rel; - $exp = 'log'; - } - else { - $title = 'Base16_'.$tmp; - } - } - $list{$title}->{$exp} = { 'style' => $style, 'size' => $size }; - } - } - - sub simple_list { - require Encode; - - local $path = shift; - local @list = (); - - &get_file_list_wrapper( $path, \&simple_wanted ); - -# @list = sort @list; - # natural sortãè¡ã - #@list = map( Encode::decode_utf8( $_ ), @list ); - @list = nsort @list; - #@list = map( Encode::encode_utf8( $_ ), @list ); - - foreach ( @list ) { - $HTML .= "$_
\n"; - } - - sub simple_wanted { - my $rel = shift; - my $abs = shift; - - my ( $size ) = &get_size( $abs ); - push @list, $rel ."\t\t". $size; - } - } - - sub get_size { - my $file = shift; - my ( $size, $last ) = (stat( $file ))[7,9]; - my @unim = ("B","KiB","MiB","GiB","TiB","PiB"); - my $count = 0; - - while($size >= 1024 ){ - $count++; - $size = $size / 1024; - } - $size *= 100; - $size = int( $size ); - $size /= 100; - if ( time - $last < 10 ) { - $style = 'â'; - } - elsif ( $size == 0 ) { - $style = 'â'; - } - else { - $style = 'â'; - } - return ( "$size $unim[$count]", $style ); - } -} - -################ mode=thumb ################ - -if ( $mode eq 'thumb' ) { - my $title = $params{ 'title' }; - my $pos = $params{ 'pos' }; - my $recording = $cfg->param( 'path.recpath' ); - - 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; -} - -################ mode=check ################ - -if ( $mode eq 'check' ) { -} - -################ mode=bravia ################ - -if ( $mode eq 'bravia' ) { - $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/; - $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}; - my $order = $params{ 'order' }; - if ( $order ne 'point' ) { - $order = 'btime'; - } - else { - $order = 'point DESC'; - } - my $ary_ref = $dbh->selectall_arrayref( - "SELECT id, chtxt, title, btime, etime, point - FROM auto_timeline_bayes - ORDER BY $order" ); - - foreach my $line ( @{ $ary_ref } ) { - my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] ); - - $line->[1] = $chtxt_chname{$line->[1]} || $line->[1]; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n\n\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - } - $HTML .= qq {

ID	ãã£ã³ãã«	ã¿ã¤ãã«	éå§æå»	çµäºæå»	é²ç»æé	ãã¤ã³ã	äºç´
$line->[0]	$line->[1]	$line->[2]	$begin	$end	$diff	$line->[5]	äºç´

\n}; - $HTML .= qq {

\n}; - -} - -################ mode=proc ################ - -if ( $mode eq 'proc' ) { - $HTML =~ s/%HTML_TITLE_OPT%/ - Proposal/; - $HTML .= qq {

\n}; - $HTML .= qq {\n\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - - my $ary_ref = $dbh->selectall_arrayref( - "SELECT type, chtxt, title - FROM auto_proc - ORDER BY title " ); - - foreach my $line ( @{ $ary_ref } ) { - my $url; - $line->[3] = $q->escape( $line->[2] ); - my $opt = $dbh->selectrow_array( - "SELECT opt FROM in_timeline_log - WHERE title = '$line->[2]' " - ); - - if ( $line->[0] eq 'auto_suggest_dec' ) { - unless ( $dbh->selectrow_array( - "SELECT 1 FROM timeline - WHERE ( type = 'convert_b25_ts' OR type = 'convert_b25_ts_running' ) - AND title = '$line->[2]' " - ) ) { - $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt}; - } - } - elsif ( $line->[0] eq 'auto_suggest_enc' ) { - unless ( $dbh->selectrow_array( - "SELECT 1 FROM timeline - WHERE ( type = 'convert_ts_mp4' OR type = 'convert_ts_mp4_running' ) - AND title = '$line->[2]' " - ) ) { - $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt}; - } - } - else { - unless ( $dbh->selectrow_array( - "SELECT 1 FROM timeline - WHERE ( type LIKE 'convert_avi%' OR type = 'convert_mkv' ) - AND title = '$line->[2]' " - ) ) { - $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]}; - } - } - if ( $url ) { - $href = qq {äºç´}; - } - else { - $href = q {äºç´æ¸}; - } - - my $color = $color{$type_suggest{$line->[0]}} ? $color{$type_suggest{$line->[0]}} : ''; - $line->[0] = $type{$line->[0]} ? $type{$line->[0]} : $line->[0]; - $line->[0] = qq {$line->[0]} if ( $color ); - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - } - - $HTML .= qq {

ã¿ã¤ã	ã¿ã¤ãã«	äºç´
$line->[0]	$line->[2]	$href

\n}; -} - -################ mode=jbk ################ - -if ( $mode eq 'jbk' ) { - $HTML =~ s/%HTML_TITLE_OPT%/ - JBK/; - $HTML .= qq {

\n}; - - if ( $mode_sub eq 'add' ) { - my $keyword = $params{ 'keyword' }; - utf8::decode( $keyword ); - $HTML .= "ãã¼ã¯ã¼ãã$keywordããè¿½å ãã¾ããã
\n"; - $dbh->do( - "INSERT INTO in_auto_jbk_key ( keyword ) - VALUES ( '$keyword' )" - ); - } - elsif ( $mode_sub eq 'del' ) { - my $id = $params{ 'id' }; - my $keyword = $dbh->selectrow_array( - "SELECT keyword FROM in_auto_jbk_key - WHERE id = '$id' " ); - $HTML .= "ãã¼ã¯ã¼ãã$keywordããåé¤ãã¾ããã
\n"; - $dbh->do( - "DELETE FROM in_auto_jbk_key WHERE id = '$id'" - ); - } - elsif ( $mode_sub eq 'on' ) { - my $id = $params{ 'id' }; - $HTML .= "ãã¼ã¯ã¼ãã$keywordããèªåé²ç»å¯¾è±¡ã«ãã¾ããã
\n"; - $dbh->do( - "UPDATE in_auto_jbk_key SET auto = 1 WHERE id = '$id'" - ); - } - elsif ( $mode_sub eq 'off' ) { - my $id = $params{ 'id' }; - $HTML .= "ãã¼ã¯ã¼ãã$keywordããèªåé²ç»å¯¾è±¡ããå¤ãã¾ããã
\n"; - $dbh->do( - "UPDATE in_auto_jbk_key SET auto = 0 WHERE id = '$id'" - ); - } - - $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}; - - my $ary_ref = $dbh->selectall_arrayref( - "SELECT id, keyword, auto, opt - FROM in_auto_jbk_key - ORDER BY id " ); - - foreach my $line ( @{ $ary_ref } ) { - my $delurl = "rectool.pl?mode=jbk&mode_sub=del&id=$line->[0]"; - my $auto = $line->[2] ? 'on' : 'off'; - my $oppo = $line->[2] ? 'off' : 'on'; - my $oppourl = "rectool.pl?mode=jbk&mode_sub=$oppo&id=$line->[0]"; - $oppo .= "ã«ãã"; - - $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 {

ID	ãã¼ã¯ã¼ã	èªåé²ç»	åãæ¿ã	é²ç»ãªãã·ã§ã³	åé¤
$line->[0]	$line->[1]	$auto	$oppo	$line->[3]	åé¤

\n}; - - $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}; - - $ary_ref = $dbh->selectall_arrayref( - "SELECT id, auto_timeline_keyword.chtxt, epg_ch.chname, title, btime, etime - FROM auto_timeline_keyword - INNER JOIN epg_ch ON auto_timeline_keyword.chtxt = epg_ch.chtxt - ORDER BY btime" - , {Slice=>{}} ); - - foreach my $line ( @{ $ary_ref } ) { - my ( $begin, $end, $diff ) = &str2readable( $line->{btime}, $line->{etime} ); - $line->{btime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/; - $line->{etime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/; - my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$line->{chtxt}&start=$line->{btime}&stop=$line->{etime}"; - - $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 {

ID	ãã£ã³ãã«	ã¿ã¤ãã«	éå§æå»	çµäºæå»	é²ç»æé	äºç´
$line->{id}	$line->{chname}	$line->{title}	$begin	$end	$diff	äºç´

\n}; - -} - -################ mode=recognize ################ - -if ( $mode eq 'recognize' ) { - $HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/; - - my $text = $params{ 'text' }; - utf8::decode( $text ); - $chtxt = $params{ 'chtxt' }; - my $title = $params{ 'title' }; - utf8::decode( $title ); - - $HTML .= qq {

\n}; - $HTML .= qq {ä¸ããããæååã®ãã¡ãçªçµã®æ¾éæå»ã¨æãããæååãèªèãã¾ãã
\n}; - $HTML .= qq {çªçµè¡¨ãåå¾ã§ããªãä¸é±éä»¥ä¸åã®äºç´ãã§ãã¾ãã
\n}; - $HTML .= qq {\n}; - - my $ch_list = join '|', grep /.+/, values %chtxt_0_chname; - my %ch_reverse = reverse %chtxt_0_chname; - - if ( $text ) { - my ( $year, $month, $day ); - my ( $bhour, $bminute, $ehour, $eminute ); - my $next_day = 0; - foreach ( split /\n/, $text ) { - my @bdate = /(\d{4}).(\d{1,2}).(\d{1,2})/; - s/(\d{4}).(\d{2}).(\d{2})//; - my @btime = /(\d{1,2})[:ï¼](\d{1,2})/; - s/(\d{1,2})[:ï¼](\d{2})//; - my @etime = /(\d{1,2})[:ï¼](\d{1,2})/; - s/(\d{1,2})[:ï¼](\d{2})//; - s/$.*$//; - if ( !@bdate ) { - $bdate[0] = Time::Piece->localtime->year; - ( $bdate[1], $bdate[2] ) = /(\d{1,2})æ(\d{1,2})æ¥/; - s/(\d{1,2})æ(\d{1,2})æ¥//; - } - next if (!( @bdate || @btime )); - ( $year, $month, $day ) = @bdate if ( $bdate[0] && $bdate[1] && $bdate[2] ); - ( $bhour, $bminute ) = @btime if ( defined $btime[0] && defined $btime[1] ); - ( $ehour, $eminute ) = @etime if ( defined $etime[0] && defined $etime[1] ); - $next_day = 1 if ( /æ·±å¤/ ); - my ( $ch ) = /($ch_list)/; - my $chtxt = $ch_reverse{$ch} if ( $ch && $ch_reverse{$ch} ); - s/($ch_list)//; - - if ( $year && $month && $day && defined $bhour && defined $bminute ) { - my $tp = Time::Piece->strptime( "$year-$month-$day $bhour:$bminute", '%Y-%m-%d %H:%M' ); - my $etp = Time::Piece->strptime( "$year-$month-$day $ehour:$eminute", '%Y-%m-%d %H:%M' ) if ( defined $ehour && defined $eminute ); - $tp += ONE_DAY if ( $next_day ); - my $start = $tp->strftime( '%Y%m%d%H%M%S' ); - my $stop = defined $etp ? - $etp->strftime( '%Y%m%d%H%M%S' ) : - ( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' ); - $title = $_ if ( !$title ); - my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$chtxt&start=$start&stop=$stop&title=$title"; - $HTML .= qq {èªèçµæ:$year-$month-$day $bhour:$bminute -> $ehour:$eminute æ®ã:$_ãªã³ã¯
\n}; - } - } - } -} - -################ mode=expert ################ - -if ( $mode eq 'expert' ) { - require List::Compare; - - my $ary_ref; - - $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/; - $HTML .= qq {

\n}; - - if ( $mode_sub eq 'reget' ) { - my $bctype = $params{ 'bctype' }; - my ( $chtxt, $chname ) = $dbh->selectrow_array( - "SELECT chtxt, chname FROM epg_ch - WHERE bctype = '$bctype' " ); - $HTML .= "Update for $chname ( chtxt: $chtxt ) has been reserved.
\n"; - $dbh->do( "UPDATE epg_ch SET status = '2' WHERE chtxt = '$chtxt' " ); - goto end; - } - - - my @ary = $dbh->selectrow_array( - "SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt - FROM in_settings " ); - my $opt = pop @ary; - @ary = map( $_ ? 'checked' : '', @ary ); - - $HTML .= qq {åé¨ãªãã·ã§ã³ã®å¤æ´\n
}; - $HTML .= qq {\n}; - - - $HTML .= qq {

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

\nå°ä¸æ³¢é²ç»æ°ï¼$ary[0]\nè¡ææ³¢é²ç»æ°ï¼$ary[1]\nè§£èªæ°ï¼$ary[2]\nç¸ææ°ï¼$ary[3]\n
\n}; - $HTML .= qq {\n}; - - - $HTML .= qq {

\nRec10 ãã¼ã¸ã§ã³ï¼$rec10_version\nrectool ãã¼ã¸ã§ã³ï¼$rectool_version\n
\n}; - - - $HTML .= qq {

\nçªçµè¡¨ã®æ¬ è½
\n}; - $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" ); - foreach my $line ( @{$ary_ref} ) { - my $ary_ref = $dbh->selectall_arrayref( - "SELECT start, stop, title FROM epg_timeline 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] !~ /ã¯ã?ã¸ã³ã°|ã¯ãã¼ã¸ã³ã°|ã¨ã³ãã£ã³ã°|ä¼æ¢|ããããã¤ã|ending/ && - $program_new->[2] !~ /ãªã¼ããã³ã°|ã¦ã£ã¼ã¯ãªã¼ã»ã¤ã³ãã©ã¡ã¼ã·ã§ã³|ã¢ã¼ãã³ã°|opening/ && - ( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[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 chname, chtxt, bctype, ch, csch, updatetime, status, visible - FROM epg_ch - 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 {

ãã£ã³ãã«å	chtxt	bctype	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, chtxt, title, btime, etime, opt, deltaday, deltatime - FROM timeline - 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}; - $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 {\n}; - } - $HTML .= qq {

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

\n}; -} - -################ mode=log ################ - -if ( $mode eq 'log' ) { - $HTML =~ s/%HTML_TITLE_OPT%/ - Log/; - - $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}; - $ary_ref = $dbh->selectall_arrayref( - "SELECT id, chtxt, title, btime, etime, opt, exp, longexp, category - FROM in_timeline_log " - ); - foreach my $line ( @{$ary_ref} ) { - $HTML .= qq {\n}; - $HTML .= qq {\n\n\n\n}; - $HTML .= qq {\n\n\n\n}; - $HTML .= qq {\n}; - $HTML .= qq {\n}; - } - $HTML .= qq {

ID	chtxt	title	btime	etime	opt	exp	longexp	category
$line->[0]	$line->[1]	$line->[2]	$line->[3]	$line->[4]	$line->[5]	$line->[6]	$line->[7]	$line->[8]

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

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

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

-$HTML .= < - - -EOM - -#

-#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV ); -my $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/; - -utf8::encode( $HTML ); -print $HTTP_HEADER; -print $HTML; -exit; - -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-Elapsed: $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}; - $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 { - $chname = $params{ 'chname' }; - $chtxt = $params{ 'chtxt' }; - $key = $params{ 'key' }; - utf8::decode( $key ); - if ( $chname ) { - $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname' "); - } - - $HTML .= qq {

\n}; - $HTML .= qq {

\n}; - $HTML .= qq {\n}; - - # ãã£ã³ãã«æå® - &draw_form_channel(); - - # æ¥ä»æå® - $HTML .= qq {\n}; - - # ã«ãã´ãªæå® - $HTML .= qq {\n}; - - # ãã¼ã¯ã¼ãæå® - $HTML .= qq {\n}; - - # ãã©ã¼ã æç» - $HTML .= qq {\n

\n}; -} - -sub draw_form_channel { - $HTML .= qq {\n}; -} - -sub draw_form_opt { - my $shift = shift; - my ( %selected, %checked ); - - if ( $chtxt =~ /BS_103/ ) { - $selected{F} = 'selected'; - } - elsif ( $chtxt =~ /CS_239|CS_240|CS_335/ ) { - $selected{H} = 'selected'; - } - elsif ( $chtxt =~ /BS_101|BS_102/ || $bctype =~ /cs/ ) { - $selected{W} = 'selected'; - } - elsif ( $bctype =~ /bs|te/ ) { - $selected{H} = 'selected'; - } - $selected{g} = 'selected'; - $selected{s} = 'selected'; - $checked{a} = $chtxt =~ /CS_331|CS_332|CS_333|CS_334|CS_335/ || $category =~ /ã¢ãã¡/ ? 'checked' : ''; - $checked{l} = ''; - $checked{d} = $title =~ /\Q[äº]\E|ï¼»äºï¼½|\Q(äº)\E|ï¼äºï¼/ ? 'checked' : ''; - $checked{5} = $title =~ /5\.1|5ï¼1/ ? 'checked' : ''; - $checked{2} = 'checked'; - - if ( $opt ) { - undef %checked; - undef %selected; - my @opt = split //, $opt; - foreach my $opt ( @opt ) { - $selected{$opt} = 'selected' if ( $opt =~ /S|L|G|H|F/ ); - $checked {$opt} = 'checked' if ( $opt =~ /a|h|l|d|2|5/ ); - } - $checked{d} = $title =~ /\Q[äº]\E|ï¼»äºï¼½|\Q(äº)\E|ï¼äºï¼/ ? 'checked' : ''; - $checked{5} = $title =~ /5\.1|5ï¼1/ ? 'checked' : ''; - } - # ç»è³ª/å§ç¸®çã¨ãã«æå®ããã¦ããªãå ´åãçãä¸ãselectedã«ãã - $selected{g} = 'selected' unless ( $selected{u} || $selected{i} || $selected{o} || $selected{p} ); - $selected{s} = 'selected' unless ( $selected{q} || $selected{w} || $selected{e} || $selected{r} ); - - $HTML .= qq {\n}; - - $HTML .= qq {\n}; - - $HTML .= qq {\n}; - - $HTML .= qq {\n}; - - $HTML .= qq {\n}; - - $HTML .= qq {24fps(ä¸»ã«ã¢ãã¡)\n}; - $HTML .= qq {äºã¶å½èªæ¾é\n}; - #$HTML .= qq {2passã¢ã¼ã\n}; - $HTML .= qq {5.1chæ¾é\n}; - $HTML .= qq {
\n}; - $HTML .= qq {\n}; - $HTML .= qq {ãã¡ã¤ã«åæ¥æè¿½å \n} if ( $shift eq 'reserve' ); - $HTML .= qq {éé±é²ç»\n} if ( $shift eq 'reserve' ); -} - -sub parse_program { - $chname = $params{ 'chname' }; - $chtxt = $params{ 'chtxt' }; - $start = $params{ 'start' }; - $stop = $params{ 'stop' }; - $bayesid = $params{ 'bayesid' }; - $id = $params{ 'id' }; - - if ( $chname ) { - $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname'"); - } - elsif ( $chtxt && $chtxt_0_chname{$chtxt} ) { - $chname = $chtxt_0_chname{$chtxt}; - ( $chtxt_sql = $chtxt ) =~ s/_0/_%/; - $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt LIKE '$chtxt_sql'"); - } - elsif ( $chtxt ) { - $chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE chtxt = '$chtxt'") - } - ( $title, $desc, $longdesc, $category ) = $dbh->selectrow_array( - "SELECT title, exp, longexp, category - FROM epg_timeline - WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' "); - if ( !$bctype ) { - $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt = '$chtxt'"); - } - - if ( $bayesid ) { - ( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array( - "SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' " - ); - ( $chname, $bctype ) = $dbh->selectrow_array( - "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' " - ); - $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' ); - $stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' ); - ( $desc, $longdesc, $category ) = $dbh->selectrow_array( - "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " - ); - } - if ( $id ) { - ( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt, $counter ) = $dbh->selectrow_array( - "SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter - FROM timeline WHERE id = '$id' " - ); - ( $chname, $bctype ) = $dbh->selectrow_array( - "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' " - ); - $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' ); - $stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' ); - ( $desc, $longdesc, $category ) = $dbh->selectrow_array( - "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " - ); - } - if ( $bctype =~ /bs|cs/ ) { - $bctype_sql = '_s%'; - } - elsif ( $bctype =~ /te/ ) { - ( $chtxt_0 = $chtxt ) =~ s/(\d+)_.*/$1_0/; - ( $chtxt_sql = $chtxt ) =~ s/_0/_%/; - $bctype_sql = 'te%'; - } - #( $chtxt_no0 ) = $chtxt =~ /(\d+)_/; - @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/; - @stop = $stop =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/; - $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' ); - $end = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' ); - - if ( $params{ 'title' } ) { - $title = $params{ 'title' }; - utf8::decode( $title ); - } - $HTML .= qq {\n}; -} - -sub check_error { - my $is_error; - my $is_same = $dbh->selectrow_array( - "SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'" - ); - my @overlap = &get_overlap(); - - if ( $is_same ) { - $HTML .= "åä¸ã®çªçµãæ¢ã«åå¨ãã¾ãã
\n"; - $is_error = 1; - } - elsif ( $overlap[0] >= 2 ) { - $HTML .= "æéãè¢«ãçªçµãæ¢ã«2ååå¨ãã¾ãã
\n"; - $HTML .= $overlap[1]; - $is_error = 2; - } - else { - $is_error = 0; - } - return $is_error; -} - -sub get_overlap { - require List::Util; - - my $ary_ref = $dbh->selectall_arrayref( - "SELECT btime, etime, title - FROM timeline - INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt - WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made - 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 get_file_list_wrapper { - local $base_dir = shift; - local $ptr = shift; - - &get_file_list( $base_dir ); -} - -sub get_file_list{ - my $dir = shift; - - opendir ( DIR, $dir ); - my @list = sort readdir( DIR ); - closedir( DIR ); - - foreach my $file ( @list ) { - next if ( $file =~ /^\.{1,2}$/ ); - if ( -d "$dir/$file" ){ - &get_file_list("$dir/$file"); - } - else{ - $abs = "$dir/$file"; - utf8::decode( $abs ); - ( $rel ) = $abs =~ /^$base_dir\/(.*)$/; - $ptr->( $rel, $abs ); - } - } -} - -sub strisjoined { - my $str = shift; - - return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1; -} - -sub str2datetime { - my $str = shift; - my @time; - - if ( strisjoined( $str ) ) { - @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], - locale => 'ja_JP' , time_zone => $tz - ); -} - -sub str2dayname { - my $str = shift; - our %day_name_cache; - - if ( !$day_name_cache{$str} ) { - $day_name_cache{$str} = str2datetime( $str )->day_name; - } - return $day_name_cache{$str}; -} - -sub str2readable { - my $begin = shift; - my $end = shift; - - my $dt_begin = ref( $begin ) eq 'DateTime' ? $begin : &str2datetime( $begin ); - my $dt_end = ref( $end ) eq 'DateTime' ? $end : &str2datetime( $end ); - - my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' ); - my $str_end = $dt_end ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : 'ç¿ %H:%M' ); - # utf8::encode( $str_begin ); - - my ( $sec, $min, $hour ); - $sec = $dt_end->epoch - $dt_begin->epoch; - $min = int( $sec / 60 ); - $sec = $sec - $min * 60; - $hour = int( $min / 60 ); - $min = $min - $hour * 60; - my $str_diff = ''; - $str_diff .= $hour . 'æé' if ( $hour ); - $str_diff .= $min . 'å' if ( $min ); - $str_diff .= $sec . 'ç§' if ( $sec ); - - return ( $str_begin, $str_end, $str_diff ); -} - -sub sqlgetsuggested { - require Encode; - require Text::Ngram; - - my ( $btime, $etime ) = @_; - $deltatime = 3 if ( !$deltatime ); - - $btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); - $btime_end = $btime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); - $etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); - $etime_end = $etime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); - - $ary_ref = $dbh->selectall_arrayref( - "SELECT start, stop, title, exp - FROM epg_timeline - WHERE channel LIKE '$chtxt_sql' - AND start BETWEEN '$btime_bgn' AND '$btime_end' - AND stop BETWEEN '$etime_bgn' AND '$etime_end' " - ); - #die Dumper $ary_ref; - - my %hash; - my $hash_r = Text::Ngram::ngram_counts( $title, 2 ); # bi-gram - foreach my $program ( @{$ary_ref} ) { - my $hash_k = Text::Ngram::ngram_counts( $program->[2], 2 ); - my $point; - map $point += $hash_k->{$_}, keys %{$hash_r}; - push @{$hash{$point}}, $program if ( $point ); - } - - return %hash; -} - +#!/usr/bin/perl +# -d:SmallProf +#use Perl6::Slurp; +#use XML::Simple; +#use CGI; +#use CGI::Lite; +#use Date::Manip; +#Date_Init("TZ=JST","ConvTZ=JST"); +#use SVG; +#use KCatch; +use warnings; +use Algorithm::Diff qw(LCS); +use Archive::Zip; +use CGI; +use CGI::Carp qw( fatalsToBrowser warningsToBrowser ); +use Config::Simple; +use Data::Dumper; +use Date::Simple; +use DateTime; +use DBI; +use MIME::Base64; +use Perl6::Slurp; +use Sort::Naturally; +use Time::Piece; +use Time::Seconds; +use Time::HiRes; +use Tie::IxHash; +#require SVG Time::Simple XML::Atom Encode Text::Ngram List::Compare List::Util +use utf8; +#%DB::packages = ( 'main' => 1 ); + + +################ ãã¼ã¸ã§ã³å®ç¾© ################ + + +my $rectool_version = 101; + + +################ åæåãããã ################ + + +my $tz = DateTime::TimeZone->new( name => 'local' ); +my $hires = Time::HiRes::time(); + +my $cfg = new Config::Simple; +if ( -e 'rec10.conf' ) { + $cfg->read( 'rec10.conf' ); +} +elsif ( -e '/etc/rec10.conf' ) { + $cfg->read( '/etc/rec10.conf' ); +} +else { + die '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, + mysql_enable_utf8 => 1, # only availavle for MySQL + }); + $dbh->do( 'SET NAMES utf8' ); +} + +my $rec10_version = eval { + $dbh->selectrow_array( "SELECT version FROM in_status " ); +}; + +my $HTML; + +$HTTP_HEADER = "Content-Type: text/html\n\n"; +$HTML .= < + + +Rec10%HTML_TITLE_OPT% + + + + + + +%REFRESH% +%SCRIPT% +%CSS% + + +%HTML_HEADER% +EOM + +my ( $user, $pass, $auth ); +( $user, $pass ) = eval { + $dbh->selectrow_array( "SELECT webuser, webpass FROM in_settings " ); +}; + +if ( $user and $pass ) { + if ( $ENV{'HTTP_AUTHORIZATION'} ) { + my ( $base64 ) = $ENV{'HTTP_AUTHORIZATION'} =~ /Basic\s(.*)/; + if ( $base64 eq encode_base64( "$user:$pass" ) ) { + $auth = 1; + } + else { + $auth = 0; + } + } + else { + $auth = 0; + } +} +else { + $auth = 1; +} + +if ( !$auth ) { + my ( $base64 ) = $ENV{'REMOTE_USER'} =~ /Basic (.*)/; + $HTTP_HEADER = qq {Status: 401 Authorization Required\nWWW-Authenticate: Basic realm="Protected Rec10 $ENV{'HTTP_AUTHORIZATION'}"\n} . $HTTP_HEADER; + goto end; +} + +if ( $rec10_version != $rectool_version ) { + $HTML .= qq {

\n}; + + if ( $rec10_version > $rectool_version ) { + $HTML .= qq {Rec10æ¬ä½ã®ãã¼ã¸ã§ã³ãæ°ãããããå®è¡ã§ãã¾ããã
\n}; + $HTML .= qq {rectoolã®ãã¼ã¸ã§ã³ã¢ãããè¡ã£ã¦ãã ããã
\n}; + } + + if ( $rec10_version < $rectool_version ) { + $HTML .= qq {Rec10æ¬ä½ã®ãã¼ã¸ã§ã³ãå¤ããããå®è¡ã§ãã¾ããã
\n}; + $HTML .= qq {Rec10ã®ãã¼ã¸ã§ã³ã¢ãããè¡ã£ã¦ãã ããã
\n}; + } + + $HTML .= qq {Rec10ã®ãã¼ã¸ã§ã³ã¯$rec10_version ãrectoolã®ãã¼ã¸ã§ã³ã¯$rectool_version ã§ãã
\n}; + $HTML .= qq {å¬å¼ãã¼ã¸\n}; + goto end; +} + +$q = new CGI; +%params = $q->Vars; +$mode = $params{ 'mode' }; +$mode_sub = $params{ 'mode_sub' }; + +################ %chtxt_chnameã®æºå ################ + +my %chtxt_chname; +my %chtxt_0_chname; +tie %chtxt_0_chname, 'Tie::IxHash'; + +my $ary_ref = $dbh->selectall_arrayref( + "SELECT chtxt, chname, ch, bctype FROM epg_ch + WHERE visible = 1" +); + +%chtxt_chname = map { $_->[0], $_->[1] } @{$ary_ref}; + +# NHK BS 1/2/hiãBS/CSããé¤å¤(101-103) - by 2011/04 +# te: å°ä¸æ³¢ãBSã®NHKä»¥å¤ +# bc: BSã®NHKãCS +my @te_ary = grep $_->[0]=~ /^\d|BS_(?!(10|19)[1-3])/, @{$ary_ref}; +my @bc_ary = grep $_->[0]!~ /^\d|BS_(?!(10|19)[1-3])/, @{$ary_ref}; + +# teã®æä½(ã¾ã¨ãã) +foreach my $line ( @te_ary ) { + # te xx_yyyy(chtxt) -> xx(ch) + if ( $line->[3] =~ /te/ ) { + push @{ $chtxt_0_chname{ $line->[2] . '_0'} }, $line->[1]; + } + else { + push @{ $chtxt_0_chname{'BS_' . $line->[2] } }, $line->[1]; + } +} +foreach my $key ( keys %chtxt_0_chname ) { + my @chname = @{ $chtxt_0_chname{$key} }; + if ( @chname >= 2 ) { + # 2ã¤ä»¥ä¸ããå ´å + my @tmp = map { my @ary = split //, $_; \@ary } @chname; + # 1ã¤ç®ã¨2ã¤ç®ã®ã¿æ¯è¼ + # FIXME: ãã¹ã¦ãæ¯è¼ããã¹ã + $chtxt_0_chname{$key} = join '', LCS( $tmp[0], $tmp[1] ); + } + else { + # 1ã¤ãããªãå ´å + $chtxt_0_chname{$key} = $chname[0]; + } +} + +# bs/csã®æä½(ãã®ã¾ã¾) +foreach my $line ( @bc_ary ) { + $chtxt_0_chname{$line->[0]} = $line->[1]; +} +undef $ary_ref; + + +################ å®æ°å®£è¨ ################ + + +tie %type, 'Tie::IxHash'; +%type = ( + 'search_everyday' => 'éæ¥æ¤ç´¢', + 'search_today' => 'å½æ¥æ¤ç´¢', + 'reserve_flexible' => 'æµ®åäºç´', + 'reserve_fixed' => 'ç¢ºå®äºç´', + + 'reserve_running' => 'é²ç»éä¸', + + 'convert_b25_ts' => 'è§£èªäºç´', + 'convert_b25_ts_running' => 'è§£èªéä¸', + 'convert_b25_ts_miss' => 'è§£èªå¤±æ', + + 'convert_ts_mp4' => 'ç¸æäºç´', + 'convert_ts_mp4_running' => 'ç¸ææ¼é¯', + 'convert_ts_mp4_network' => 'ç¸ææ¼ç¶²', + 'convert_ts_mp4_finished' => 'ç¸æå®äº', + + 'convert_avi_mkv' => 'å¤ææ§é²', + 'convert_avi_mp4' => 'å¤ææ§å', + 'convert_mkv_mp4' => 'å¤æé²å', + 'convert_mkv_mp4_runnings' => 'æéé²å', + + 'auto_suggest_dec' => 'äºæ¸¬è§£èª', + 'auto_suggest_enc' => 'äºæ¸¬ç¸æ', + 'auto_suggest_avi2fp' => 'äºæ¸¬æ§å', + 'auto_suggest_ap2fp' => 'äºæ¸¬é²å', + + 'move_end' => 'ç§»åå®äº', +); + +%type_suggest = ( + 'auto_suggest_dec' => 'convert_b25_ts', + 'auto_suggest_enc' => 'convert_ts_mp4', + 'auto_suggest_avi2fp' => 'convert_avi_mkv', + 'auto_suggest_ap2fp' => 'convert_mp4_mkv', +); + +%color = ( + 'search_everyday' => '#8B008B', + 'search_today' => '#8B008B', + 'reserve_flexible' => '#4169E1', + 'reserve_fixed' => '#4169E1', + 'reserve_running' => '#FF8C00', + 'convert_b25_ts' => '#CD5C5C', + 'convert_b25_ts_running' => '#DC143C', + 'convert_ts_mp4' => '#32CD32', + 'convert_ts_mp4_running' => '#2E8B57', + 'convert_ts_mp4_network' => '#808000', + + 'other' => '#A0A0A0', +); + +$type_user_made = "( 'search_everyday', 'search_today', 'reserve_flexible', 'reserve_fixed', 'reserve_running' )"; + +tie %category, 'Tie::IxHash'; +%category = ( + 'news' => { name => 'ãã¥ã¼ã¹ã»å ±é' , color => '#ff0000' }, + 'sports' => { name => 'ã¹ãã¼ã' , color => '#ff8000' }, + 'information' => { name => 'æå ±' , color => '#ffff00' }, + 'drama' => { name => 'ãã©ã' , color => '#80ff00' }, + 'music' => { name => 'é³æ¥½' , color => '#00ff00' }, + 'variety' => { name => 'ãã©ã¨ãã£' , color => '#00ff80' }, + 'cinema' => { name => 'æ ç»' , color => '#00ffff' }, + 'anime' => { name => 'ã¢ãã¡ã»ç¹æ®' , color => '#0080ff' }, + 'documentary' => { name => 'ããã¥ã¡ã³ã¿ãªã¼ã»æé¤' , color => '#0000ff' }, + 'stage' => { name => 'æ¼å' , color => '#8000ff' }, + 'hobby' => { name => 'è¶£å³ã»å®ç¨' , color => '#ff00ff' }, + 'etc' => { name => 'ãã®ä»' , color => '#ff0080' }, +); + +################ åæåããã¾ã§ ################ + + +################ mode=schedule ################ + +if ( $mode eq 'schedule' ) { + + $HTML =~ s/%HTML_TITLE_OPT%/ - Schedule Viewer/; + #$HTML =~ s|%REFRESH%||; + $css = < + td { + white-space: nowrap; + } + +EOM + $css =~ s/^\t{2}//gm; + $HTML =~ s/%CSS%/$css/; + + my $order = $params{ 'order' }; + my $extra = $params{ 'extra' }; + if ( $order ne 'id' ) { + $order = 'btime'; + } + $reverse_extra = $extra ? '' : '&extra=1'; + $forward_order = $order eq 'btime' ? '' : '&order=id'; + + my $ary_ref = $dbh->selectall_arrayref( + "SELECT id, type, timeline.chtxt, epg_ch.chname, title, btime, etime, opt, deltaday, deltatime, + epgtitle, epgbtime, epgetime, epgexp, epgduplicate, epgchange, counter + FROM timeline + LEFT OUTER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt + ORDER BY $order" + , {Slice=>{}}); + + $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}; + $HTML .= qq {\n}; + foreach my $line ( @{ $ary_ref } ) { + + $type = $type{$line->{type}} || $line->{type}; + if ( $line->{type} =~ /^search/ ) { + $type = qq {$type}; + $line->{deltaday} = qq {ç©º} if ( !$line->{deltaday} && $line->{type} eq 'search_everyday' ); + $line->{deltatime} = qq {ç©º} if ( !$line->{deltatime} ); + } + else { + my $color = $color{$line->{type}} ? $color{$line->{type}} : $color{'other'}; + $type = qq {$type}; + } + # å°ä¸æ³¢ã®å ´åãxx_yyyãxx_0ã«ç½®æãã + ( $line->{chtxt_0} = $line->{chtxt} ) =~ s/(\d+)_/$1_0/; + # chnameãç¡ãã¨ã(ç§»åç¸æãªã©)ãchtxtãä»£ããã«ä½¿ã + $line->{chname} = + $line->{chname} || + $chtxt_0_chname{$line->{chtxt}} || + $chtxt_0_chname{$line->{chtxt_0}}; + if ( !$line->{chname} ) { + # chnameãç¡ãã¨ãããªã³ã¯ãä½æããªã + $line->{chname} = $line->{chtxt}; + $line->{chname_link} = qq {$line->{chname}}; + } + else { + $line->{chname_link} = qq {$line->{chname}}; + } + $line->{title} = 'ã¿ã¤ãã«ãªã' if ( !$line->{title} ); + $line->{tr_style} = ''; + $line->{title_2} = ''; + my $unix_b = str2datetime( $line->{btime} ); + my $unix_e = str2datetime( $line->{etime} ); + + my $btime = $unix_b->strftime( '%Y%m%d%H%M%S' ); + my $etime = $unix_e->strftime( '%Y%m%d%H%M%S' ); + if ( $extra and $line->{type} =~ /^search_|^reserve_(?!running)/ ) { + #my @ary = $dbh->selectrow_array( + # "SELECT title, exp FROM epg_timeline + # WHERE channel = '$line->{chname}' + # AND start = '$btime' + # AND stop = '$etime' "); + #my @ary = ( $line->{epgtitle}, $line->{epgexp} ); + my ( $epgtitle, $epgexp ) = ( $line->{epgtitle}, $line->{epgexp} ); + + if ( $epgtitle ) { + $epgtitle =~ s/ç¡æâ«//; + + if ( $epgtitle ne $line->{title} ) { + # epgtitleã¨titleãä¸è´ããªã + # []ã«å²ã¾ããé¨åãé¤å»ãã¦æ¯è¼ + my @brackets = $line->{title} =~ /(\[.+\])+/; + my $epgtitle_nobrackets = $epgtitle; + my $title_nobrackets = $line->{title}; + if ( @brackets && $epgtitle =~ /(\[.+\])+/ >= @brackets ) { + foreach ( @brackets ) { + $epgtitle_nobrackets =~ s/\Q$_\E//; + } + } + $title_nobrackets =~ s/(\[.+\])+//; + if ( !scalar $epgtitle_nobrackets =~ s/\Q$title_nobrackets\E// ) { + # epgtitleã«titleãå«ã¾ãã¦ããªã + my $href = qq {èªåæ¤ç´¢}; + $epgtitle = qq {$epgtitleâ $hrefâ }; + } + else { + # epgtitleã«titleãå«ã¾ãã¦ãã + $epgtitle = $epgtitle_nobrackets; + } + } + else { + # epgtitleã¨titleãä¸è´ãã¦ãã + $epgtitle = 'èª¬æ'; + } + + $line->{title_2} = qq {

$epgtitle

}; + } + else { + # epgtitleããªã + my $href = qq {èªåæ¤ç´¢}; + $line->{title_2} = qq {â $hrefâ }; + $line->{tr_style} = qq {style="background-color: #A0A0A0"}; + } + } + + my ( $begin, $end, $diff ) = &str2readable( $unix_b, $unix_e ); + + my $hr = ''; + if ( + $line->{type} eq 'reserve_running' + && + $unix_b->epoch <= time && time <= $unix_e->epoch + ) + { + $percent = int( ( 100 * ( time - $unix_b->epoch ) ) / ( $unix_e->epoch - $unix_b->epoch ) ); + $hr .= qq {

}; + } + + $line->{title} = qq {$line->{title}}; + #$line->{title} = qq {

$line->{title}

} if ( $line->{title_2} ); + $HTML .= qq {{tr_style}>\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\n}; + $HTML .= qq {\n}; + } + $HTML .= qq {

â	ID	ã¿ã¤ã	ãã£ã³ãã«	ã¿ã¤ãã«	éå§æå»	çµäºæå»	é²ç»æé	ãªãã·ã§ã³	dd	dt	æ®ã
	$line->{id}	$type	$line->{chname_link}	$line->{title}$line->{title_2}	$begin	$end	$hr$diff	$line->{opt}	$line->{deltaday}	$line->{deltatime}	$line->{counter}

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

\n}; + goto end; +} + +################ mode=graph ################ + +if ( $mode eq 'graph' ) { + + my $date = $params{ 'date' }; + + if ( $date ) + { + print "Content-Type: image/svg+xml\n\n"; + + require SVG; + $date = Date::Simple->new( split /-/, $date ); + $graph_bgn = $date->format('%Y-%m-%d'); + $graph_end = $date->next->format('%Y-%m-%d'); + $day = $date->day; + $today = $date eq Date::Simple->today() ? 1 : 0; + + $tuner{terrestrial} = $cfg->param( 'env.te_max' );# 2; + $tuner{satellite} = $cfg->param( 'env.bscs_max' );# 2; + $tuner{all} = $tuner{terrestrial} + $tuner{satellite}; + $hours = 24; + $width = 30 * $hours; + my %category_color = map { $_->{name}, $_->{color} } values %category; + + $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 be used 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->tag( 'line', x1 =>50, x2 => 50 + $width, y1 => $_ * 20 + 10, y2 => $_ * 20 + 10, +# style => { stroke => 'gray' } ); +# $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 10, width => $width, height => 10 ); + $svg->rectangle( 'x' => 50, 'y' => $_ * 20 + 14, width => $width, height => 2 ); + } + 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' } ); + } + my $ary_ref = $dbh->selectall_arrayref( + # epg_timeline.channel = timeline.chtxt && + "SELECT id, title, chtxt, btime, etime, epgcategory, opt FROM timeline + WHERE type IN $type_user_made + 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 btime" + , {Slice=>{}} + ); + + foreach my $bctype ( '\d+_', 'S_' ) { + my $tuner = $bctype eq '\d+_' ? $tuner{terrestrial} : $tuner{satellite}; + my @ary_ref = grep { $_->{chtxt} =~ /$bctype/ } @{ $ary_ref }; + my @y_drawn = ('') x $tuner; + foreach my $line ( @ary_ref ) { + @start = $line->{btime} =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2})/; + @stop = $line->{etime} =~ /(.{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->{btime}; + $end = $line->{etime}; + + my @ary = grep { ( $_->{etime} cmp $line->{btime} ) > 0 and ( $_->{btime} cmp $line->{etime} ) < 0 and $_->{id} != $line->{id} } @ary_ref; + foreach my $i ( 0..$tuner - 1 ) { + next if ( ( $y_drawn[$i] cmp $line->{btime} ) > 0 ); + #for ( 'chtxt', 'btime', 'etime' ) { + # $f = 0 if ( $line->{$_} ne $ary[$i]->{$_} ); + #} + $line->{slot} = $i; + $y_drawn[$i] = $line->{etime}; + last; + } + my ( $r, $g, $b ) = ( 0, 0, 0 ); + $r += 255 if ( $line->{opt} =~ /a/ ); + $g += 255 if ( $line->{opt} =~ /H/ ); + $b += 255 if ( $line->{opt} =~ /I/ ); + 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->{id}", + target => '_blank', + -title => html_escape( $line->{title} ), + )->rectangle( + 'x' => 50 + $start, + 'y' => 30 + ( $bctype eq '\d+_' ? 0 : $tuner{terrestrial} * 20 ) + $line->{slot} * 20, + width => $stop - $start, + height => 10, + style => { fill => $category_color{$line->{epgcategory}} || $category_color{'ãã®ä»'} } ); + #style => { fill => "rgb($r,$g,$b)" } ); + } + } + my $xml = $svg->xmlify; + utf8::encode( $xml ); + print $xml; + #warningsToBrowser(true); + 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ãç¤ºãã¦ãã¾ãã
\n}; + $HTML .= qq {SVGãå©ç¨å¯è½ãªãã©ã¦ã¶ã§ãè¦§ãã ããã
\n}; + $HTML .= qq {è²ã¨ã¸ã£ã³ã«ã®å¯¾å¿\n}; + map { + $HTML .= qq {$_->{name}\n}; + } values %category; + $HTML .= qq {
\n}; + + $ary_ref = $dbh->selectcol_arrayref( + "SELECT DISTINCT DATE( btime ) + FROM timeline + WHERE type in $type_user_made + 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 timeline + 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; + } +} + +################ mode=atom ################ + +if ( $mode eq 'atom' ) { + require XML::Atom::Feed; + require XML::Atom::Entry; + + my $recording_count = $encoding_count = $jbk_count = 0; + my $ary_ref = $dbh->selectall_arrayref( + "SELECT chtxt, title, btime, etime, opt + FROM timeline + WHERE type = 'reserve_running' "); + foreach my $line ( @{$ary_ref} ) { + my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] ); + $recording_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]
\n}; + $recording_count++; + } + $ary_ref = $dbh->selectall_arrayref( + "SELECT chtxt, title, btime, etime, opt + FROM timeline + WHERE type = 'convert_ts_mp4_running' "); + foreach my $line ( @{$ary_ref} ) { + my ( $begin, $end, $diff ) = &str2readable( $line->[2], $line->[3] ); + $encoding_status .= qq {$line->[0] $line->[1] $begin - $end $diff $line->[4]
\n}; + $encoding_count++; + } + $ary_ref = $dbh->selectall_arrayref( + "SELECT id, chtxt, title, btime, etime + FROM auto_timeline_keyword " ); + foreach my $line ( @{$ary_ref} ) { + my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] ); + $jbk_status .= qq {$line->[0] $line->[1] $line->[2] $begin - $end $diff
\n}; + $jbk_count++; + } + + my $feed = XML::Atom::Feed->new( Version => 1.0 ); + $feed->title('Rec10 ãã£ã¼ã'); + + my $entry = XML::Atom::Entry->new( Version => 1.0 ); + $entry->title("Rec10 é²ç»ç¶æ³ ($recording_count)"); + $entry->id('tag:recording_status'); + $entry->content($recording_status); + $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) ); + $feed->add_entry($entry); + + $entry = XML::Atom::Entry->new( Version => 1.0 ); + $entry->title("Rec10 ç¸æç¶æ³ ($encoding_count)"); + $entry->id('tag:encoding_status'); + $entry->content($encoding_status); + $entry->add_link(str_to_link( './rectool.pl?mode=schedule' ) ); + $feed->add_entry($entry); + + $entry = XML::Atom::Entry->new( Version => 1.0 ); + $entry->title("Rec10 å°å¼ç¶æ³ ($jbk_count)"); + $entry->id('tag:jbk_status'); + $entry->content($jbk_status); + $entry->add_link(str_to_link( './rectool.pl?mode=jbk' ) ); + $feed->add_entry($entry); + + my $xml = $feed->as_xml; + print "Content-Type: application/atom+xml\n\n"; + print $xml; + exit; + + sub str_to_link { + my $link = XML::Atom::Link->new( Version => 1.0 ); + $link->type('text/html'); + $link->rel('alternate'); + $link->href(shift); + return $link; + } +} + +################ mode=edit ################ + +if ( $mode eq 'edit' ) { + my $id = $params{ 'id' }; + + $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 ) { + # äºç´ã®ç·¨é + &parse_program(); + $button_bgn = $button_end = ''; + } + else { + # æ°è¦äºç´ + $type = 'reserve_flexible'; + $counter = -1; + $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 1)->strftime( '%Y-%m-%d %H:%M:%S' ); + $button_bgn = qq{\n
\n}; + $button_end = + qq{} + .qq{} + .qq{}; + } + + if ( $params{ 'suggest' } eq 'auto' ) { + my @btime = $begin =~ /(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/; + my @etime = $end =~ /(.{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], + ); + my %hash = &sqlgetsuggested( $btime, $etime ); + + $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 $id; + $HTML .= qq {

\n}; + $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}; + $HTML .= $button_bgn; + $HTML .= qq {çµäºæå»\n\n}; + $HTML .= $button_end . "
\n"; + $HTML .= qq {éæ¥å¨æ\n\n}; + $HTML .= qq {æå»èª¤å·®\n\n}; + $HTML .= qq {ãªãã·ã§ã³\n\n}; + $HTML .= qq {åæ°\n\n}; + $HTML .= qq {\n

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

\n}; + + if ( $params{ 'delete' } ) + { + if ( @id ) { + foreach my $id ( @id ) { + $dbh->do( "DELETE FROM timeline WHERE id = '$id'" ); + } + $HTML .= "åé¤ãã¾ããã
\n5ç§å¾ã«äºç´ç¢ºèªç»é¢ã«ç§»åãã¾ãã
\n"; + $HTML =~ s|%REFRESH%||; + goto end; + } + } + if ( $params{ 'update' } ) + { + $type = $params{ 'type' }; + $chtxt = $params{ 'chtxt' }; + $title = $params{ 'title' }; + $begin = $params{ 'begin' }; + $end = $params{ 'end' }; + $deltaday = $params{ 'deltaday' }; + $deltatime = $params{ 'deltatime' }; + $opt = $params{ 'opt' }; + $counter = $params{ 'counter' }; + $id = $id[0]; + if ( $id ) { + $dbh->do( + "UPDATE timeline SET type = '$type', chtxt = '$chtxt', title = '$title', + btime = '$begin', etime = '$end', + deltaday = '$deltaday', deltatime = '$deltatime', opt = '$opt', counter = '$counter' + WHERE id = '$id'" + ); + } + else { + $dbh->do( + "INSERT INTO timeline ( type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter ) + VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$deltaday', '$deltatime', '$opt', '$counter' )" + ); + } + $HTML .= "æ´æ°ãã¾ããã
\n5ç§å¾ã«äºç´ç¢ºèªç»é¢ã«ç§»åãã¾ãã
\n"; + $HTML =~ s|%REFRESH%||; + goto end; + } + if ( $mode_sub eq 'proc' ) { + my $type = $params{ 'type' }; + my $chtxt = $params{ 'chtxt' } || 'nhk-k'; + my $title = $params{ 'title' }; + my @opt = $q->param( 'opt' ); + my $opt = join '', @opt; + + my $datetime_now = DateTime->now( time_zone => $tz )->set_second( 0 )->add( minutes => 10); + my $sql_type = $type_suggest{$type}; + my $begin = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' ); + $datetime_now = $datetime_now->add( minutes => 60 ); + my $end = $datetime_now->strftime( '%Y-%m-%d %H:%M:%S' ); + + $dbh->do( + "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt ) + VALUES ( '$sql_type', '$chtxt', '$title', '$begin', '$end', '$opt' )" + ); + + goto end; + } + if ( $mode_sub eq 'move' ) { + my $mode_sub2 = $params{ 'mode_sub2' }; + my $title = $params{ 'title' }; + my $response; + + $ENV{'LANG'} = 'ja_JP.UTF-8'; + if ( $mode_sub2 eq 'predict' ) { + $HTML .= "ç§»åå¾ã®ã·ãã¥ã¬ã¼ã·ã§ã³çµæã§ãã\n
"; + eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -s '$title'`"; + } + elsif ( $mode_sub2 eq 'exec' ) { + eval '$response = `python26 ' . $cfg->param( 'path.rec10' ) . "/classify.py -e '$title'`"; + } + utf8::decode( $response ); + $HTML .= $response; + + goto end; + } + if ( $mode_sub eq 'setting' ) { + my $jbk = $params{ 'jbk' } || '0'; + my $bayes = $params{ 'bayes' } || '0'; + my $del_tmp = $params{ 'del_tmp' } || '0'; + my $opt = $params{ 'opt' } || ''; + my $user = $params{ 'user' } || ''; + my $pass = $params{ 'pass' } || ''; + + $dbh->do( + "UPDATE in_settings SET auto_jbk = '$jbk', auto_bayes = '$bayes', + auto_del_tmp = '$del_tmp', auto_opt = '$opt'" + ); + + goto end; + } + if ( $mode_sub eq 'fixstatus' ) { + my $key = $params{ 'terec' } ? 'terec' : $params{ 'bscsrec' } ? 'bscsrec' : + $params{ 'b252ts' } ? 'b252ts' : $params{ 'ts2avi' } ? 'ts2avi' : ''; + + $dbh->do( + "UPDATE in_status SET $key = 0" + ); + + goto end; + } + +} + +################ mode=confirm ################ + +if ( $mode eq 'confirm' ) { + if ( $mode_sub eq 'reserve' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Reserver/; + $HTML .= qq {

\n}; + &parse_program(); + + my $duration = ( str2datetime( $end ) - str2datetime( $begin ) )->delta_minutes; + $HTML .= "çªçµåï¼$title
\nãã£ã³ãã«ï¼$chname
\næ¾éç¶ç¶æéï¼$duration å
\nçªçµåå®¹ï¼$desc
\nã¸ã£ã³ã«ï¼$category
\n"; + if ( $longdesc ) { + $longdesc =~ s/\\n/
\n/gs; + $HTML .= "çªçµåå®¹(é·)ï¼$longdesc
\n"; + } + my $error = &check_error(); + if ( $error ) + { + # ã¨ã©ã¼ + + $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop FROM epg_timeline WHERE channel = '$chtxt' AND title = '$title' " + ); + if ( $error != 1 ) { + $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 { + $HTML .= "é²ç»äºç´ã®è©³ç´°è¨å®ãè¡ã£ã¦ãã ããã
\n"; + $HTML .= qq {\n}; + } + goto end; + } + # End of $mode_sub eq 'reserve'; + + if ( $mode_sub eq 'proc' ) { + my $type = $params{ 'type' }; + local $chtxt = $params{ 'chtxt' }; + my $title = $params{ 'title' }; + local $opt = $params{ 'opt' }; + utf8::decode( $title ); + + $HTML .= "è©³ç´°è¨å®ãè¡ã£ã¦ãã ããã
\n"; + $HTML .= "ã¿ã¤ãã«ï¼$title\n
\n"; + + $HTML .= qq {\n}; + goto end; + } +} + +################ mode=reserve ################ + +if ( $mode eq 'reserve' ) { + $HTML .= qq {

\n}; + &parse_program(); + $title = $params{ 'title' } if ( !$title ); + @opt = $q->param( 'opt' ); + $opt = join '', @opt; + my ( $deltaday, $deltatime ); + + if ( $params{'every'} eq '1' ) { + $type = 'search_everyday'; + ( $changed_t ) = $title =~ /(.*)#/; + $title = $changed_t if ( $changed_t ); + ( $changed_t ) = $title =~ /(.*)ç¬¬/; + $title = $changed_t if ( $changed_t ); + ( $changed_t ) = $title =~ /(.*)â½/; + $title = $changed_t if ( $changed_t ); + $title =~ s/ã.*ã//; + $title =~ s/ï¼.*ï¼//; + $title =~ s/ï¼.*ï¼//; + $title =~ s/\[æ°\]//; + $title =~ s/ç¡æâ«//; + $title =~ s/\s*$//; + $deltaday = 7; + $deltatime = 3; + } + else { + $type = 'reserve_flexible'; + } + $chtxt = $chtxt_0 if ( $chtxt_0 ); + if ( !&check_error ) { + $dbh->do( + "INSERT INTO timeline ( type, chtxt, title, btime, etime, opt, deltaday, deltatime ) + VALUES ( '$type', '$chtxt', '$title', '$begin', '$end', '$opt', '$deltaday', '$deltatime' )" + ); + } + $HTML .= "é²ç»äºç´ãå®è¡ãã¾ããã
\n5ç§å¾ã«ãããã¸ç§»åãã¾ãã
\n"; + $HTML =~ s|%REFRESH%||; + goto end; +} + +################ mode=program ################ + +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 channel, epg_ch.chname, start, stop, title, category + FROM epg_timeline + INNER JOIN epg_ch ON epg_timeline.channel = epg_ch.chtxt + WHERE $unix <= stop %CH% %DATE% %CATEGORY% %KEY% ORDER BY start"; + + if ( $chtxt ) { + my $ch; + if ( $chtxt =~ /^\d+(_0)?$/ ) { + # teã¯xx_yyyå½¢å¼ã§ãããã + $chtxt =~ s/_0//; + $ch = "AND channel LIKE '$chtxt\_%'"; + } + else { + $ch = "AND channel = '$chtxt'"; + } + $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{$category_sel}->{name}'"; + $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], + locale => 'ja_JP' + ); + + my $dn = $date->day_name; + #utf8::encode( $dn ); + $HTML .= qq {--------$date[1]/$date[2]($dn)--------
\n}; + } + $HTML .= qq {$date[1]/$date[2] $date[3]:$date[4] }; + $HTML .= qq {$prg->[1] } if ( !$chtxt ); + $HTML .= qq {$prg->[4]
\n}; + $prev = $date; + } +} + +################ mode=list ################ + +if ( $mode eq 'list' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - List/; + $HTML .= qq {

\n}; + + $script = < + + + + +EOM + $script =~ s/^\t{2}//gm; + $HTML =~ s/%SCRIPT%/$script/; + + my $recording = $cfg->param( 'path.recpath' ); + my $ts_movepath = $cfg->param( 'path.ts_movepath' ); + my $recorded = $cfg->param( 'path.recorded' ); + + if ( $mode_sub eq 'log' ) { + my $title = $params{ 'title' }; + my $log = slurp( "$recording/$title.log" ) if ( -e "$recording/$title.log" ); + utf8::decode( $log ); + $HTML .= '

'.$log."

\n"; + goto end; + } + if ( $mode_sub eq 'logzip' ) { + my $title = $params{ 'title' }; + my $zip = Archive::Zip->new(); + my $logzip; + die 'read error' unless $zip->read("$recording/$title.log.zip") == AZ_OK; + my @members = $zip->members(); + foreach (@members) { + $logzip .= $_->fileName() . "\n"; + my @lines = split /\n|\r/, $zip->contents( $_->fileName() ); + my %count; + @lines = grep {!$count{$_}++} @lines; + $logzip .= join "\n", @lines; + $logzip .= "\n

\n"; + } + + utf8::decode( $logzip ); + $HTML .= '

'.$logzip."

\n"; + goto end; + } + if ( $mode_sub eq 'ffmpeg' ) { + my $path = $params{ 'path' }; + # mediainfo (not working) + # ffprobe + my $ffmpeg = `ffmpeg -i "$path" 2>&1`; + utf8::decode($ffmpeg); + $ffmpeg = join "
\n", grep /Duration|Stream/, split /\n/, $ffmpeg; + $HTML = $ffmpeg; + goto end; + } + if ( !$mode_sub ) { + $HTML .= qq {é²ç»ä¸ã®ã¿\n}; + $HTML .= qq {é²ç»å¾ã®ã¿\n
\n}; + } + if ( !$mode_sub || $mode_sub eq 'new' ) { + $HTML .= "é²ç»ä¸ã®ãã¡ã¤ã«ä¸è¦§
\n"; + &list( $recording ); + } + if ( !$mode_sub ) { + $HTML .= "
\n"; + } + if ( !$mode_sub || $mode_sub eq 'old' ) { + $HTML .= "é²ç»å¾ã®ãã¡ã¤ã«ä¸è¦§
\n"; + &simple_list( $ts_movepath ); + &simple_list( $recorded ); + } + + sub list { + local $path = shift; + local %list = (); + my @exp = ( 'log', 'log.zip', 'ts.b25', 'ts.tsmix', 'ts', 'ts.log', + 'aac', 'srt', 'm2v', 'wav', '264', 'mp4', 'mkv' ); + for ( 0..$#exp ) { + $exp{$exp[$_]} = $_; + } + my $exp_count = scalar keys %exp; + + &get_file_list_wrapper( $path, \&wanted ); + + my $help; + foreach my $name ( sort { $exp{$a} <=> $exp{$b} } keys %exp ) { + $help .= $exp{$name} + 1 . " = $name / "; + } + $HTML .= $help; + $help = qq {$help\n\n}; + $help .= qq {$_\n} for ( 1..$exp_count ); + + $HTML .= qq {
\nâ = å®äº / â = æ¸ãè¾¼ã¿ä¸ / â = ãã¡ã¤ã«ãµã¤ãºç°å¸¸
\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n} for ( 1..$exp_count ); + $HTML .= qq {\n}; + + my $count = 0; + + foreach my $title ( sort keys %list ) { + my $value = $list{$title}; + my @flag = ( 0 ) x ( $exp_count ); + $HTML .= qq {\n\n}; + foreach my $exp ( keys %{$value} ) { + if ( $exp eq 'log' ) { + # ãã°ã¸ã®ãªã³ã¯ãè¿½å + my $title = $q->escape( $title ); + my $extra = qq {\n}; + + $value->{$exp}->{extra} = $extra; + } + elsif ( $exp eq 'log.zip' ) { + # ZIPãã°ã¸ã®ãªã³ã¯ãè¿½å + my $title = $q->escape( $title ); + my $extra = qq {\n}; + + $value->{$exp}->{extra} = $extra; + } + elsif ( $exp eq 'mp4' ) { + # âãªã©ã®ä»£ããã«ãµã¤ãºãè¡¨ç¤º + # $value->{$exp}->{style} = $value->{$exp}->{size}; + my $size = $value->{$exp}->{size}; + my $extra = qq {\n}; + $value->{$exp}->{extra} = $extra; + } + elsif ( $exp eq 'mkv' ) { + # ãµã ãã¤ã«ã¸ã®ãªã³ã¯ãè¿½å + my $title = $q->escape( $title ); + + my $extra = qq {\n}; + $value->{$exp}->{extra} = $extra; + } + $flag[$exp{$exp}] = $value->{$exp}; + } + foreach ( @flag ) { + my $size = $_->{size}; + my $style = $_->{style}; + my $span = $size ? qq {$style} : '
'; + $HTML .= $_->{extra} || qq {\n}; + } + $HTML .= qq {\n}; + $HTML .= $help unless ( ++$count % 20 ); + } + $HTML .= qq {

ã¿ã¤ãã«	$_
$title	â	â	$size	â	$span

\n}; + + sub wanted { + my $rel = shift; + my $abs = shift; + + return if ( $rel =~ /Thumbs\.db/ ); + return if ( $rel =~ /\.idx/ ); + + $rel =~ s/\.temp$//; + my $regexp = join '|', keys %exp; + my ( $title, $exp ) = $rel =~ /(.*?)\.($regexp)$/; + my ( $size, $style ) = &get_size( $abs ); + $rel =~ s/\.temp$//; + if ( !$title ) { + $title = '_error_exp_'.$rel; + $exp = 'log'; + } + if ( $title !~ /[^0-9A-F]+/ ) { + my $tmp = pack( 'H*', $title ); + if ( !$tmp ) { + $title = '_error_b16_'.$rel; + $exp = 'log'; + } + else { + $title = 'Base16_'.$tmp; + } + } + $list{$title}->{$exp} = { 'style' => $style, 'size' => $size }; + } + } + + sub simple_list { + require Encode; + + local $path = shift; + local @list = (); + + &get_file_list_wrapper( $path, \&simple_wanted ); + +# @list = sort @list; + # natural sortãè¡ã + #@list = map( Encode::decode_utf8( $_ ), @list ); + @list = nsort @list; + #@list = map( Encode::encode_utf8( $_ ), @list ); + + foreach ( @list ) { + $HTML .= "$_
\n"; + } + + sub simple_wanted { + my $rel = shift; + my $abs = shift; + + my ( $size ) = &get_size( $abs ); + $rel = qq {$rel}; + push @list, $rel ."\t".$result."\t". $size; + } + } + + sub get_size { + my $file = shift; + my ( $size, $last ) = (stat( $file ))[7,9]; + my @unim = ("B","KiB","MiB","GiB","TiB","PiB"); + my $count = 0; + + while($size >= 1024 ){ + $count++; + $size = $size / 1024; + } + $size *= 100; + $size = int( $size ); + $size /= 100; + if ( time - $last < 10 ) { + $style = 'â'; + } + elsif ( $size == 0 ) { + $style = 'â'; + } + else { + $style = 'â'; + } + return ( "$size $unim[$count]", $style ); + } +} + +################ mode=thumb ################ + +if ( $mode eq 'thumb' ) { + my $title = $params{ 'title' }; + my $pos = $params{ 'pos' }; + my $recording = $cfg->param( 'path.recpath' ); + + 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; +} + +################ mode=check ################ + +if ( $mode eq 'check' ) { +} + +################ mode=bravia ################ + +if ( $mode eq 'bravia' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Bravia/; + $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}; + my $order = $params{ 'order' }; + if ( $order ne 'point' ) { + $order = 'btime'; + } + else { + $order = 'point DESC'; + } + my $ary_ref = $dbh->selectall_arrayref( + "SELECT id, chtxt, title, btime, etime, point + FROM auto_timeline_bayes + ORDER BY $order" ); + + foreach my $line ( @{ $ary_ref } ) { + my ( $begin, $end, $diff ) = &str2readable( $line->[3], $line->[4] ); + + $line->[1] = $chtxt_chname{$line->[1]} || $line->[1]; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + } + $HTML .= qq {

ID	ãã£ã³ãã«	ã¿ã¤ãã«	éå§æå»	çµäºæå»	é²ç»æé	ãã¤ã³ã	äºç´
$line->[0]	$line->[1]	$line->[2]	$begin	$end	$diff	$line->[5]	äºç´

\n}; + $HTML .= qq {

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

\n}; + $HTML .= qq {\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + + my $ary_ref = $dbh->selectall_arrayref( + "SELECT type, chtxt, title + FROM auto_proc + ORDER BY title " ); + + foreach my $line ( @{ $ary_ref } ) { + my $url; + $line->[3] = $q->escape( $line->[2] ); + my $opt = $dbh->selectrow_array( + "SELECT opt FROM in_timeline_log + WHERE title = '$line->[2]' " + ); + + if ( $line->[0] eq 'auto_suggest_dec' ) { + unless ( $dbh->selectrow_array( + "SELECT 1 FROM timeline + WHERE ( type = 'convert_b25_ts' OR type = 'convert_b25_ts_running' ) + AND title = '$line->[2]' " + ) ) { + $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt}; + } + } + elsif ( $line->[0] eq 'auto_suggest_enc' ) { + unless ( $dbh->selectrow_array( + "SELECT 1 FROM timeline + WHERE ( type = 'convert_ts_mp4' OR type = 'convert_ts_mp4_running' ) + AND title = '$line->[2]' " + ) ) { + $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]&opt=$opt}; + } + } + else { + unless ( $dbh->selectrow_array( + "SELECT 1 FROM timeline + WHERE ( type LIKE 'convert_avi%' OR type = 'convert_mkv' ) + AND title = '$line->[2]' " + ) ) { + $url = qq {rectool.pl?mode=confirm&mode_sub=proc&type=$line->[0]&chtxt=$line->[1]&title=$line->[3]}; + } + } + if ( $url ) { + $href = qq {äºç´}; + } + else { + $href = q {äºç´æ¸}; + } + + my $color = $color{$type_suggest{$line->[0]}} ? $color{$type_suggest{$line->[0]}} : ''; + $line->[0] = $type{$line->[0]} ? $type{$line->[0]} : $line->[0]; + $line->[0] = qq {$line->[0]} if ( $color ); + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + } + + $HTML .= qq {

ã¿ã¤ã	ã¿ã¤ãã«	äºç´
$line->[0]	$line->[2]	$href

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

\n}; + + if ( $mode_sub eq 'add' ) { + my $keyword = $params{ 'keyword' }; + utf8::decode( $keyword ); + $HTML .= "ãã¼ã¯ã¼ãã$keywordããè¿½å ãã¾ããã
\n"; + $dbh->do( + "INSERT INTO in_auto_jbk_key ( keyword ) + VALUES ( '$keyword' )" + ); + } + elsif ( $mode_sub eq 'del' ) { + my $id = $params{ 'id' }; + my $keyword = $dbh->selectrow_array( + "SELECT keyword FROM in_auto_jbk_key + WHERE id = '$id' " ); + $HTML .= "ãã¼ã¯ã¼ãã$keywordããåé¤ãã¾ããã
\n"; + $dbh->do( + "DELETE FROM in_auto_jbk_key WHERE id = '$id'" + ); + } + elsif ( $mode_sub eq 'on' ) { + my $id = $params{ 'id' }; + $HTML .= "ãã¼ã¯ã¼ãã$keywordããèªåé²ç»å¯¾è±¡ã«ãã¾ããã
\n"; + $dbh->do( + "UPDATE in_auto_jbk_key SET auto = 1 WHERE id = '$id'" + ); + } + elsif ( $mode_sub eq 'off' ) { + my $id = $params{ 'id' }; + $HTML .= "ãã¼ã¯ã¼ãã$keywordããèªåé²ç»å¯¾è±¡ããå¤ãã¾ããã
\n"; + $dbh->do( + "UPDATE in_auto_jbk_key SET auto = 0 WHERE id = '$id'" + ); + } + + $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}; + + my $ary_ref = $dbh->selectall_arrayref( + "SELECT id, keyword, auto, opt + FROM in_auto_jbk_key + ORDER BY id " ); + + foreach my $line ( @{ $ary_ref } ) { + my $delurl = "rectool.pl?mode=jbk&mode_sub=del&id=$line->[0]"; + my $auto = $line->[2] ? 'on' : 'off'; + my $oppo = $line->[2] ? 'off' : 'on'; + my $oppourl = "rectool.pl?mode=jbk&mode_sub=$oppo&id=$line->[0]"; + $oppo .= "ã«ãã"; + + $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 {

ID	ãã¼ã¯ã¼ã	èªåé²ç»	åãæ¿ã	é²ç»ãªãã·ã§ã³	åé¤
$line->[0]	$line->[1]	$auto	$oppo	$line->[3]	åé¤

\n}; + + $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}; + + $ary_ref = $dbh->selectall_arrayref( + "SELECT id, auto_timeline_keyword.chtxt, epg_ch.chname, title, btime, etime + FROM auto_timeline_keyword + INNER JOIN epg_ch ON auto_timeline_keyword.chtxt = epg_ch.chtxt + ORDER BY btime" + , {Slice=>{}} ); + + foreach my $line ( @{ $ary_ref } ) { + my ( $begin, $end, $diff ) = &str2readable( $line->{btime}, $line->{etime} ); + $line->{btime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/; + $line->{etime} =~ s/(.{4})-(.{2})-(.{2}) (.{2}):(.{2}):(.{2})/$1$2$3$4$5$6/; + my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$line->{chtxt}&start=$line->{btime}&stop=$line->{etime}"; + + $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 {

ID	ãã£ã³ãã«	ã¿ã¤ãã«	éå§æå»	çµäºæå»	é²ç»æé	äºç´
$line->{id}	$line->{chname}	$line->{title}	$begin	$end	$diff	äºç´

\n}; + +} + +################ mode=recognize ################ + +if ( $mode eq 'recognize' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Recognizer/; + + my $text = $params{ 'text' }; + utf8::decode( $text ); + $chtxt = $params{ 'chtxt' }; + my $title = $params{ 'title' }; + utf8::decode( $title ); + + $HTML .= qq {

\n}; + $HTML .= qq {ä¸ããããæååã®ãã¡ãçªçµã®æ¾éæå»ã¨æãããæååãèªèãã¾ãã
\n}; + $HTML .= qq {çªçµè¡¨ãåå¾ã§ããªãä¸é±éä»¥ä¸åã®äºç´ãã§ãã¾ãã
\n}; + $HTML .= qq {\n}; + + my $ch_list = join '|', grep /.+/, values %chtxt_0_chname; + my %ch_reverse = reverse %chtxt_0_chname; + + if ( $text ) { + my ( $year, $month, $day ); + my ( $bhour, $bminute, $ehour, $eminute ); + my $next_day = 0; + foreach ( split /\n/, $text ) { + my @bdate = /(\d{4}).(\d{1,2}).(\d{1,2})/; + s/(\d{4}).(\d{2}).(\d{2})//; + my @btime = /(\d{1,2})[:ï¼](\d{1,2})/; + s/(\d{1,2})[:ï¼](\d{2})//; + my @etime = /(\d{1,2})[:ï¼](\d{1,2})/; + s/(\d{1,2})[:ï¼](\d{2})//; + s/$.*$//; + if ( !@bdate ) { + $bdate[0] = Time::Piece->localtime->year; + ( $bdate[1], $bdate[2] ) = /(\d{1,2})æ(\d{1,2})æ¥/; + s/(\d{1,2})æ(\d{1,2})æ¥//; + } + next if (!( @bdate || @btime )); + ( $year, $month, $day ) = @bdate if ( $bdate[0] && $bdate[1] && $bdate[2] ); + ( $bhour, $bminute ) = @btime if ( defined $btime[0] && defined $btime[1] ); + ( $ehour, $eminute ) = @etime if ( defined $etime[0] && defined $etime[1] ); + $next_day = 1 if ( /æ·±å¤/ ); + my ( $ch ) = /($ch_list)/; + my $chtxt = $ch_reverse{$ch} if ( $ch && $ch_reverse{$ch} ); + s/($ch_list)//; + + if ( $year && $month && $day && defined $bhour && defined $bminute ) { + my $tp = Time::Piece->strptime( "$year-$month-$day $bhour:$bminute", '%Y-%m-%d %H:%M' ); + my $etp = Time::Piece->strptime( "$year-$month-$day $ehour:$eminute", '%Y-%m-%d %H:%M' ) if ( defined $ehour && defined $eminute ); + $tp += ONE_DAY if ( $next_day ); + my $start = $tp->strftime( '%Y%m%d%H%M%S' ); + my $stop = defined $etp ? + $etp->strftime( '%Y%m%d%H%M%S' ) : + ( $tp + ONE_MINUTE * 30 )->strftime( '%Y%m%d%H%M%S' ); + $title = $_ if ( !$title ); + my $url = qq "rectool.pl?mode=confirm&mode_sub=reserve&chtxt=$chtxt&start=$start&stop=$stop&title=$title"; + $HTML .= qq {èªèçµæ:$year-$month-$day $bhour:$bminute -> $ehour:$eminute æ®ã:$_ãªã³ã¯
\n}; + } + } + } +} + +################ mode=expert ################ + +if ( $mode eq 'expert' ) { + require List::Compare; + + my $ary_ref; + + $HTML =~ s/%HTML_TITLE_OPT%/ - Expert/; + $HTML .= qq {

\n}; + + if ( $mode_sub eq 'reget' ) { + my $bctype = $params{ 'bctype' }; + my ( $chtxt, $chname ) = $dbh->selectrow_array( + "SELECT chtxt, chname FROM epg_ch + WHERE bctype = '$bctype' " ); + $HTML .= "Update for $chname ( chtxt: $chtxt ) has been reserved.
\n"; + $dbh->do( "UPDATE epg_ch SET status = '2' WHERE chtxt = '$chtxt' " ); + goto end; + } + + + my @ary = $dbh->selectrow_array( + "SELECT auto_jbk, auto_bayes, auto_del_tmp, auto_opt + FROM in_settings " ); + my $opt = pop @ary; + @ary = map( $_ ? 'checked' : '', @ary ); + + $HTML .= qq {åé¨ãªãã·ã§ã³ã®å¤æ´\n
}; + $HTML .= qq {\n}; + + + $HTML .= qq {

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

\nå°ä¸æ³¢é²ç»æ°ï¼$ary[0]\nè¡ææ³¢é²ç»æ°ï¼$ary[1]\nè§£èªæ°ï¼$ary[2]\nç¸ææ°ï¼$ary[3]\n
\n}; + $HTML .= qq {\n}; + + + $HTML .= qq {

\nRec10 ãã¼ã¸ã§ã³ï¼$rec10_version\nrectool ãã¼ã¸ã§ã³ï¼$rectool_version\n
\n}; + + + $HTML .= qq {

\nçªçµè¡¨ã®æ¬ è½
\n}; + $ary_ref = $dbh->selectall_arrayref( "SELECT chname, chtxt FROM epg_ch" ); + foreach my $line ( @{$ary_ref} ) { + my $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop, title FROM epg_timeline 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] !~ /ã¯ã?ã¸ã³ã°|ã¯ãã¼ã¸ã³ã°|ã¨ã³ãã£ã³ã°|ä¼æ¢|ããããã¤ã|ending/ && + $program_new->[2] !~ /ãªã¼ããã³ã°|ã¦ã£ã¼ã¯ãªã¼ã»ã¤ã³ãã©ã¡ã¼ã·ã§ã³|ã¢ã¼ãã³ã°|opening/ && + ( str2datetime( $program_new->[0] ) - str2datetime( $program_old->[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 chname, chtxt, bctype, ch, csch, updatetime, status, visible + FROM epg_ch + 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 {

ãã£ã³ãã«å	chtxt	bctype	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, chtxt, title, btime, etime, opt, deltaday, deltatime + FROM timeline + 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}; + $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 {\n}; + } + $HTML .= qq {

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

\n}; +} + +################ mode=log ################ + +if ( $mode eq 'log' ) { + $HTML =~ s/%HTML_TITLE_OPT%/ - Log/; + + $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}; + $ary_ref = $dbh->selectall_arrayref( + "SELECT id, chtxt, title, btime, etime, opt, exp, longexp, category + FROM in_timeline_log " + ); + foreach my $line ( @{$ary_ref} ) { + $HTML .= qq {\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n\n\n\n}; + $HTML .= qq {\n}; + $HTML .= qq {\n}; + } + $HTML .= qq {

ID	chtxt	title	btime	etime	opt	exp	longexp	category
$line->[0]	$line->[1]	$line->[2]	$line->[3]	$line->[4]	$line->[5]	$line->[6]	$line->[7]	$line->[8]

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

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

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

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

+#$HTML_ADV = $HTML_ADV_IMG . $HTML_ADV_TEXT if ( !$HTML_ADV ); +my $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/; + +utf8::encode( $HTML ); +print $HTTP_HEADER; +print $HTML; +exit; + +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-Elapsed: $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}; + $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 { + $chname = $params{ 'chname' }; + $chtxt = $params{ 'chtxt' }; + $key = $params{ 'key' }; + utf8::decode( $key ); + if ( $chname ) { + $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname' "); + } + + $HTML .= qq {

\n}; + $HTML .= qq {

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

\n}; +} + +sub draw_form_channel { + $HTML .= qq {\n}; +} + +sub draw_form_opt { + my $shift = shift; + my ( %selected, %checked ); + + if ( $chtxt =~ /BS_103/ ) { + $selected{F} = 'selected'; + } + elsif ( $chtxt =~ /CS_239|CS_240|CS_335/ ) { + $selected{H} = 'selected'; + } + elsif ( $chtxt =~ /BS_101|BS_102/ || $bctype =~ /cs/ ) { + $selected{W} = 'selected'; + } + elsif ( $bctype =~ /bs|te/ ) { + $selected{H} = 'selected'; + } + $selected{g} = 'selected'; + $selected{s} = 'selected'; + $checked{a} = $chtxt =~ /CS_331|CS_332|CS_333|CS_334|CS_335/ || $category =~ /ã¢ãã¡/ ? 'checked' : ''; + $checked{l} = ''; + $checked{d} = $title =~ /\Q[äº]\E|ï¼»äºï¼½|\Q(äº)\E|ï¼äºï¼/ ? 'checked' : ''; + $checked{5} = $title =~ /5\.1|5ï¼1/ ? 'checked' : ''; + $checked{2} = 'checked'; + + if ( $opt ) { + undef %checked; + undef %selected; + my @opt = split //, $opt; + foreach my $opt ( @opt ) { + $selected{$opt} = 'selected' if ( $opt =~ /S|L|G|H|F/ ); + $checked {$opt} = 'checked' if ( $opt =~ /a|h|l|d|2|5/ ); + } + $checked{d} = $title =~ /\Q[äº]\E|ï¼»äºï¼½|\Q(äº)\E|ï¼äºï¼/ ? 'checked' : ''; + $checked{5} = $title =~ /5\.1|5ï¼1/ ? 'checked' : ''; + } + # ç»è³ª/å§ç¸®çã¨ãã«æå®ããã¦ããªãå ´åãçãä¸ãselectedã«ãã + $selected{g} = 'selected' unless ( $selected{u} || $selected{i} || $selected{o} || $selected{p} ); + $selected{s} = 'selected' unless ( $selected{q} || $selected{w} || $selected{e} || $selected{r} ); + + $HTML .= qq {\n}; + + $HTML .= qq {\n}; + + $HTML .= qq {\n}; + + $HTML .= qq {\n}; + + $HTML .= qq {\n}; + + $HTML .= qq {24fps(ä¸»ã«ã¢ãã¡)\n}; + $HTML .= qq {äºã¶å½èªæ¾é\n}; + #$HTML .= qq {2passã¢ã¼ã\n}; + $HTML .= qq {5.1chæ¾é\n}; + $HTML .= qq {
\n}; + $HTML .= qq {\n}; + $HTML .= qq {ãã¡ã¤ã«åæ¥æè¿½å \n} if ( $shift eq 'reserve' ); + $HTML .= qq {éé±é²ç»\n} if ( $shift eq 'reserve' ); +} + +sub parse_program { + $chname = $params{ 'chname' }; + $chtxt = $params{ 'chtxt' }; + $start = $params{ 'start' }; + $stop = $params{ 'stop' }; + $bayesid = $params{ 'bayesid' }; + $id = $params{ 'id' }; + + if ( $chname ) { + $chtxt = $dbh->selectrow_array("SELECT chtxt FROM epg_ch WHERE chname = '$chname'"); + } + elsif ( $chtxt && $chtxt_0_chname{$chtxt} ) { + $chname = $chtxt_0_chname{$chtxt}; + ( $chtxt_sql = $chtxt ) =~ s/_0/_%/; + $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt LIKE '$chtxt_sql'"); + } + elsif ( $chtxt ) { + $chname = $dbh->selectrow_array("SELECT chname FROM epg_ch WHERE chtxt = '$chtxt'") + } + ( $title, $desc, $longdesc, $category ) = $dbh->selectrow_array( + "SELECT title, exp, longexp, category + FROM epg_timeline + WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' "); + if ( !$bctype ) { + $bctype = $dbh->selectrow_array("SELECT bctype FROM epg_ch WHERE chtxt = '$chtxt'"); + } + + if ( $bayesid ) { + ( $chtxt, $title, $begin, $end ) = $dbh->selectrow_array( + "SELECT chtxt, title, btime, etime FROM auto_timeline_bayes WHERE id = '$bayesid' " + ); + ( $chname, $bctype ) = $dbh->selectrow_array( + "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' " + ); + $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' ); + $stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' ); + ( $desc, $longdesc, $category ) = $dbh->selectrow_array( + "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " + ); + } + if ( $id ) { + ( $type, $chtxt, $title, $begin, $end, $deltaday, $deltatime, $opt, $counter ) = $dbh->selectrow_array( + "SELECT type, chtxt, title, btime, etime, deltaday, deltatime, opt, counter + FROM timeline WHERE id = '$id' " + ); + ( $chname, $bctype ) = $dbh->selectrow_array( + "SELECT chname, bctype FROM epg_ch WHERE chtxt = '$chtxt' " + ); + $start = str2datetime( $begin )->strftime( '%Y%m%d%H%M%S' ); + $stop = str2datetime( $end )->strftime( '%Y%m%d%H%M%S' ); + ( $desc, $longdesc, $category ) = $dbh->selectrow_array( + "SELECT exp, longexp, category FROM epg_timeline WHERE channel = '$chtxt' AND start = '$start' AND stop = '$stop' " + ); + } + if ( $bctype =~ /bs|cs/ ) { + $bctype_sql = '_s%'; + } + elsif ( $bctype =~ /te/ ) { + ( $chtxt_0 = $chtxt ) =~ s/(\d+)_.*/$1_0/; + ( $chtxt_sql = $chtxt ) =~ s/_0/_%/; + $bctype_sql = 'te%'; + } + #( $chtxt_no0 ) = $chtxt =~ /(\d+)_/; + @start = $start =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/; + @stop = $stop =~ /(.{4})(.{2})(.{2})(.{2})(.{2})/; + $begin = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @start, '00' ); + $end = sprintf( '%04d-%02d-%02d %02d:%02d:%02d', @stop , '00' ); + + if ( $params{ 'title' } ) { + $title = $params{ 'title' }; + utf8::decode( $title ); + } + $HTML .= qq {\n}; +} + +sub check_error { + my $is_error; + my $is_same = $dbh->selectrow_array( + "SELECT COUNT(*) FROM timeline WHERE chtxt = '$chtxt' AND btime = '$begin' AND etime = '$end'" + ); + my @overlap = &get_overlap(); + + if ( $is_same ) { + $HTML .= "åä¸ã®çªçµãæ¢ã«åå¨ãã¾ãã
\n"; + $is_error = 1; + } + elsif ( $overlap[0] >= 2 ) { + $HTML .= "æéãè¢«ãçªçµãæ¢ã«2ååå¨ãã¾ãã
\n"; + $HTML .= $overlap[1]; + $is_error = 2; + } + else { + $is_error = 0; + } + return $is_error; +} + +sub get_overlap { + require List::Util; + + my $ary_ref = $dbh->selectall_arrayref( + "SELECT btime, etime, title + FROM timeline + INNER JOIN epg_ch ON timeline.chtxt = epg_ch.chtxt + WHERE bctype LIKE '$bctype_sql' AND type IN $type_user_made + 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 get_file_list_wrapper { + local $base_dir = shift; + local $ptr = shift; + + &get_file_list( $base_dir ); +} + +sub get_file_list{ + my $dir = shift; + + opendir ( DIR, $dir ); + my @list = sort readdir( DIR ); + closedir( DIR ); + + foreach my $file ( @list ) { + next if ( $file =~ /^\.{1,2}$/ ); + if ( -d "$dir/$file" ){ + &get_file_list("$dir/$file"); + } + else{ + $abs = "$dir/$file"; + utf8::decode( $abs ); + ( $rel ) = $abs =~ /^$base_dir\/(.*)$/; + $ptr->( $rel, $abs ); + } + } +} + +sub strisjoined { + my $str = shift; + + return $str =~ /.{4}-.{2}-.{2} .{2}:.{2}:.{2}/ ? 0 : 1; +} + +sub str2datetime { + my $str = shift; + my @time; + + if ( strisjoined( $str ) ) { + @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], + locale => 'ja_JP' , time_zone => $tz + ); +} + +sub str2dayname { + my $str = shift; + our %day_name_cache; + + if ( !$day_name_cache{$str} ) { + $day_name_cache{$str} = str2datetime( $str )->day_name; + } + return $day_name_cache{$str}; +} + +sub str2readable { + my $begin = shift; + my $end = shift; + + my $dt_begin = ref( $begin ) eq 'DateTime' ? $begin : &str2datetime( $begin ); + my $dt_end = ref( $end ) eq 'DateTime' ? $end : &str2datetime( $end ); + + my $str_begin = $dt_begin->strftime( '%m/%d(%a) %H:%M' ); + my $str_end = $dt_end ->strftime( $dt_begin->day == $dt_end->day ? '%H:%M' : 'ç¿ %H:%M' ); + # utf8::encode( $str_begin ); + + my ( $sec, $min, $hour ); + $sec = $dt_end->epoch - $dt_begin->epoch; + $min = int( $sec / 60 ); + $sec = $sec - $min * 60; + $hour = int( $min / 60 ); + $min = $min - $hour * 60; + my $str_diff = ''; + $str_diff .= $hour . 'æé' if ( $hour ); + $str_diff .= $min . 'å' if ( $min ); + $str_diff .= $sec . 'ç§' if ( $sec ); + + return ( $str_begin, $str_end, $str_diff ); +} + +sub sqlgetsuggested { + require Encode; + require Text::Ngram; + + my ( $btime, $etime ) = @_; + $deltatime = 3 if ( !$deltatime ); + + $btime_bgn = $btime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); + $btime_end = $btime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); + $etime_bgn = $etime->clone->subtract( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); + $etime_end = $etime->clone->add( hours => $deltatime )->strftime( '%Y%m%d%H%M%S' ); + + $ary_ref = $dbh->selectall_arrayref( + "SELECT start, stop, title, exp + FROM epg_timeline + WHERE channel LIKE '$chtxt_sql' + AND start BETWEEN '$btime_bgn' AND '$btime_end' + AND stop BETWEEN '$etime_bgn' AND '$etime_end' " + ); + #die Dumper $ary_ref; + + my %hash; + my $hash_r = Text::Ngram::ngram_counts( $title, 2 ); # bi-gram + foreach my $program ( @{$ary_ref} ) { + my $hash_k = Text::Ngram::ngram_counts( $program->[2], 2 ); + my $point; + map $point += $hash_k->{$_}, keys %{$hash_r}; + push @{$hash{$point}}, $program if ( $point ); + } + + return %hash; +} +