Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris
 
PerlMonks  

comment on

( [id://3333]=superdoc: print w/replies, xml ) Need Help??
#!/usr/bin/perl # Download latest from http://zentara.net/ztk-tvguide use warnings; use strict; use Tk; use Tk::Animation; use Tk::ROText; require Tk::ErrorDialog; use Tk::DialogBox; use threads; use threads::shared; #------ User settings ------------------------------------------------ +------- #get your channels from your xmltv config file--------------- my $xml_grabber = 'tv_grab_na_dd'; #the helper script for your locati +on, #from the xmltv module, this is No +rth America #created by running 'tv_grab_na_dd + --configure' #------ End normal user setting -------------------------------------- +---- #------ these settings will need to change if you try this on windows- +----- # the xmltv dir is usually C:\share\xmltv on windows ? my $config = "$xml_grabber.conf"; my $home = "$ENV{HOME}/.xmltv"; my $xml_dir = "$home/ztk_tvguide"; #print "$xml_dir\n"; my $config_loc = "$home/$config"; # -------------------------------------------------------------------- +---- ################################################################## # Original Author: # A product of zentara - zentara@zentara.net http://zentara.net # Copyright (c) 2005 by zentara., All rights reserved # Author: Joseph B. Milosch ( a.k.a. zentara ) ################################################################## # This program is free software; you can redistribute it and/or modify + # it under the terms of the GNU General Public License as published by + # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version, WITH THE FOLLOWING EXCEPTION: # You may not remove the the Original Author copyright information abo +ve, # or this license information. # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. ###################################################################### +## # version 1b posted September 16,2005 ###################################################################### +## open (EH,"< $config_loc") or die "Need xmltv config $!\n"; if(! -e $xml_dir){mkdir $xml_dir} # ; get_new_xml();} my (undef,undef,$h,$m) = get_time(time); #get available days previously downloaded and have them #in hashes for conversions my %dates_d8; #convert YYYYMMDD to 'dayname month day' my %dates_str; #convert 'dayname month day' to YYYYMMDD &fill_date_hashes; #load the above hashes #---------------------------------------------------------- my %channels = (); while(<EH>){ if( $_ =~ /^channel.*/){ my (undef,$chan,$id) = split /\s+/, $_ ; $channels{$chan}{'id'} = $id; } } close EH; my @chs = sort { $a <=> $b } keys %channels; # ascending order my $num_channels = scalar @chs; my @chs_orig = @chs; #------------------------------------------------------------- my $max_prog_chan = 60; #48 half hours/day + 12 fudge factor #############shared hashes for xml processor################# my %days; foreach my $channel(@chs){ foreach my $count(0..$max_prog_chan){ share $days{$channel}{$count}{'channel'}; share $days{$channel}{$count}{'channel_info'}; share $days{$channel}{$count}{'episode_num'}; share $days{$channel}{$count}{'start'}; share $days{$channel}{$count}{'stop'}; share $days{$channel}{$count}{'makedate'}; share $days{$channel}{$count}{'description'}; share $days{$channel}{$count}{'title'}; share $days{$channel}{$count}{'writer'}; share $days{$channel}{$count}{'director'}; share $days{$channel}{$count}{'actors'}; share $days{$channel}{$count}{'rating'}; share $days{$channel}{$count}{'length'}; share $days{$channel}{$count}{'category'}; share $days{$channel}{$count}{'star_rating'}; } } my $load_timer; my @finished = (); share @finished; my %shash; share $shash{'go'}; share $shash{'progress'}; share $shash{'channels'}; share $shash{'xml_dir'}; share $shash{'day'}; share $shash{'data'}; share $shash{'pid'}; share $shash{'die'}; $shash{'go'} = 0; $shash{'progress'} = 0; $shash{'channels'} = @chs; $shash{'xmldir'} = $xml_dir; $shash{'day'} = ''; $shash{'data'} = ''; $shash{'pid'} = ''; $shash{'die'} = 0; $shash{'thread'} = threads->new( \&xmlwork); ################################################### ##########shared hash for downloader thread########### my @finished_down =(); my @to_download = (); share @finished_down; share @to_download; my %dhash; share $dhash{'go'}; share $dhash{'progress'}; share $dhash{'output'}; share $dhash{'xml_dir'}; share $dhash{'config_loc'}; share $dhash{'die'}; $dhash{'go'} = 0; $dhash{'progress'} = 0; $dhash{'output'} = ''; $dhash{'xmldir'} = $xml_dir; $dhash{'config_loc'} = $config_loc; $dhash{'die'} = 0; $dhash{'thread'} = threads->new( \&downthread); ######################################################## my %slots; my %pixel_time; my $screen_set = 0; my $EXIT = 0; $SIG{INT} = sub{ warn "Caught Zap!\n"; $EXIT = 1 }; #Send this a ^C and it will exit gracefully. my $mw = new MainWindow(); $mw->geometry("600x400+200+200"); $mw->protocol('WM_DELETE_WINDOW' => sub {&clean_exit }); #create and withdraw a toplevel for download progress monitoring my $top = $mw->Toplevel; $top->title('Download Details'); $top->Label(-text => 'Download Details', -bg=>'black', -fg=>'green', )->pack(-fill=>'x',-expand=>1); my $mtext = $top->Scrolled('Text', -bg=>'black', -fg=>'lightgreen', -scrollbars=>'osoe', )->pack(); $top->Button( -text => 'Close', -command => sub{$top->withdraw}, )->pack; $top->withdraw; ################################################################ $mw->fontCreate('big', -family=>'arial', -weight=>'bold', -size=> 18 ); $mw->fontCreate('medium', -family=>'arial', -weight=>'bold', -size=> 14 ); $mw->fontCreate('small', -family=>'helvetica', -weight=>'bold', -size=> 10 ); my $topframe = $mw->Frame(-bg=>'black')->pack(-fill=>'x', -expand => 1 +); my $topframel = $topframe->Frame(-bg=>'black')->pack(-side=>'left'); my $topframem = $topframe->Frame(-bg=>'black')->pack(-side=>'left',-fi +ll=>'x', -expand => 1); $topframel->Button(-text=>'Exit', -command=>\&clean_exit)->pack(-side=>'top',-pady=>1 +); my $image = $mw->Animation('-format' => 'gif', -data => get_gif() ); my $image1 = $mw->Animation('-format' => 'gif', -data => get_gif1() ) +; my $toppframe = $topframel->Frame(-bg=>'black')->pack(-side=>'top',-fi +ll=>'x',-expand=>1); #xml loading animation my $infolabel = $toppframe->Label(-image =>$image, -bg=>'black', )->pack(-side =>'right',-pady=>2,-padx= +>10); #downloading animation my $infolabel1 = $toppframe->Label(-image =>$image1, -bg=>'black', )->pack(-side =>'left',-pady=>2,-padx=> +10); my $down_but = $topframel->Button(-text=>"Download Days\nAhead", -command=>sub{ &do_download }, )->pack(-side=>'top',-pady=>3); my $canvasp; my $infobox; my @dchoices = &get_day_choices(); my $selected = $dchoices[0]; my $prev_sel = 0; #prevent reloading same xml file my $om = $topframel->Optionmenu( -width => 12, -options => \@dchoices, -textvariable => \$selected, -command => sub { $infolabel->focus(); #do stuff to load new file &load_program( $dates_str{$selected} ); }, -background => 'black', -fg => 'green', -highlightthickness =>1, -highlightbackground=>'red', )->pack(-side=>'bottom',-pady=>2); $infobox = $topframem->Scrolled('ROText', -height => 10, -bg => 'lightyellow', -fg => 'black', -font => 'medium', -wrap => 'word', -scrollbars => 'oe', )->pack(-side => 'top', -fill=>'x'); #add colors $infobox->tagConfigure( 'tagr', -foreground => 'red' ); $infobox->tagConfigure( 'tagb', -foreground => 'black' ); $infobox->tagConfigure( 'tagg', -foreground => 'green' ); my $midframe = $mw->Frame(-bg=>'grey45')->pack(); my $midframel = $midframe->Frame(-bg=>'grey45') ->pack(-side=>'left',-expand=>1,-fill=>'y'); my $midframer = $midframe->Frame(-bg=>'grey45') ->pack(-side=>'right'); my $canvast = $midframer->Scrolled('Canvas', -bg =>'pale goldenrod', -width=>2400, -height=>25, -scrollregion=>[-10,0,7250,25], -scrollbars =>'e', -xscrollincrement => 1, ) ->pack(-side=>'top'); $canvasp = $midframer->Scrolled('Canvas', -bg =>'lightsteelblue', -width=>2400, -height=> 50 * $num_channels, -scrollregion=>[-10,0,7250,(33 * $num_channels)], -scrollbars=>'se', -xscrollincrement => 1, -yscrollincrement => 1, ) ->pack(-side=>'bottom',-fill=>'both'); my $realcanvas = $canvasp->Subwidget('scrolled'); #get global length of time in medium font my $tfont_len = $canvasp->fontMeasure('medium', '00:00 ' ); my $canvasd = $midframel->Canvas( -bg =>'grey45', -width=>75, -height=>25, ) ->pack(-side=>'top'); my $canvass = $midframel->Scrolled('Canvas', -bg =>'lightsteelblue', -width=>75, -height=> 50 * $num_channels, -scrollregion=>[0,0,75,(33 * $num_channels)], -scrollbars =>'s', -yscrollincrement => 1, ) ->pack(-side=>'top'); my $xscroll = $canvasp->Subwidget("xscrollbar"); my $yscroll = $canvasp->Subwidget("yscrollbar"); $xscroll->configure(-troughcolor =>'grey45', -activebackground =>'lightseagreen', -background =>'lightseagreen', -command => \&xscrollit, ); $yscroll->configure(-troughcolor =>'grey45', -activebackground =>'lightseagreen', -background => 'lightseagreen', -command => \&yscrollit, ); #hidden and disabled scrollbars my $xscroll1 = $canvass->Subwidget("xscrollbar"); my $yscroll1 = $canvast->Subwidget("yscrollbar"); $xscroll1->configure(-troughcolor =>'grey45', -activebackground =>'grey45', -background =>'grey45', -highlightcolor =>'grey45', -highlightbackground => 'grey45', -elementborderwidth => 0, -relief => 'flat', ); $yscroll1->configure(-troughcolor =>'grey45', -activebackground =>'grey45', -background =>'grey45', -highlightcolor =>'grey45', -highlightbackground => 'grey45', -elementborderwidth => 0, -relief => 'flat', ); ############################################################## # set and update the time pointer my $tmarker; &set_pointer(); #update every 5 minutes $mw->repeat(300000,sub{ $canvast->delete($tmarker); &set_pointer() }); sub set_pointer{ my (undef,undef,$h,$m) = get_time(time); #setup current time pointer... a pink arrow my $s = $h* 300; $s += $m * 5; $tmarker = $canvast->createLine($s, 0,$s, 20, -width =>10, -arrow=>'last', -arrowshape =>[5,5,5], -fill => 'hotpink', -tags => ['marker'], ); $canvast->xviewMoveto( ($s-150)/7200); $canvasp->xviewMoveto( ($s-150)/7200); } ############################################################## #create timebar and markers for(0..7200){ if( $_ % 300 == 0){ my $time = $_ / 300; my $padded = ("0" x (2-length( $time ))).$time; $canvast->createLine($_,0,$_,12,-width=> 4,-tags=>['tick'] ); $canvast->createText($_, 20, -text=> "$padded:00",-tags=>['ti +ck'] ); }elsif( $_ % 150 == 0){ my $time = ($_ - 150) / 300; my $padded = ("0" x (2-length( $time ))).$time; $canvast->createLine($_,0,$_,10,-width => 2,-tags=>['tick']); $canvast->createText($_, 20, -text=> "$padded:30",-tags=>['ti +ck'] ); }elsif( $_ % 75 == 0){ $canvast->createLine($_,0,$_,6,-width => 1,-tags=>['tick']); } } #---------create station boxes--------------------------------- for(0 .. $num_channels){ my $ch = shift @chs || last; $slots{$_}{'channel'} = $ch; $slots{$_}{'top'} = 2 + $_ * 33; $slots{$_}{'bottom'} = 31 + $_ * 33; $slots{$_}{'toptext'} = 2 + $_ * 33; $slots{$_}{'midtext'} = 11 + $_ * 33; #store which slot contains which channels $slots{'flip'}{$ch} = $_; $canvass->createRectangle(0, 2 + $_ * 33, 75, 31 + $_ * 33 , -fill =>'#f4dae4' ); $canvass->createText(38, 10 + $_ * 33, -text => $ch , -font => 'big' ); $canvass->createText(38, 22 + $_ * 33, -text => $channels{$ch}{'id'} , -font => 'medium', -fill => 'blue' ); } my $startuptimer; $startuptimer = $mw->repeat(5,sub{ if ($mw->ismapped){ $startuptimer->cancel; if( defined $selected ){ load_program( $dates_str{$selected} ); } } }); $canvasp->bind('info', '<Enter>', sub { $infobox->delete('1.0','end'); my $id = $canvasp->find('withtag','current'); my (undef,$ch,$num,undef) = $canvasp->gettags($id); if(length $days{ $ch }{ $num }{'title'}){ $infobox->insert('end','TITLE: ','tagr'); $infobox->insert('end', "$days{ $ch }{ $num }{'title'}\n",'tagb'); } if(length $days{ $ch }{ $num }{'description'}){ $infobox->insert('end','DESCRIPTION: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'description'}\n",'tagb' +); } if(length $days{ $ch }{ $num }{'category'}){ $infobox->insert('end','CATEGORY: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'category'} ",'tagb'); } if(length $days{ $ch }{ $num }{'star_rating'}){ $infobox->insert('end', 'STAR RATING: ','tagr'); $infobox->insert('end', "$days{ $ch }{ $num }{'star_rating'} ",'tagb +'); } if(length $days{ $ch }{ $num }{'rating'}){ $infobox->insert('end','Rating: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'rating'} ",'tagb'); } if(length $days{ $ch }{ $num }{'makedate'}){ $infobox->insert('end',' Made On: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'makedate'}\n",'tagb'); }else{ $infobox->insert('end',"\n") } if(length $days{ $ch }{ $num }{'writer'}){ $infobox->insert('end','WRITER: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'writer'} ",'tagb'); } if(length $days{ $ch }{ $num }{'director'}){ $infobox->insert('end','DIRECTOR: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'director'} ",'tagb'); } if(length $days{ $ch }{ $num }{'length'}){ $infobox->insert('end','LENGTH: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'length'}\n",'tagb'); }else{ $infobox->insert('end',"\n") } if(length $days{ $ch }{ $num }{'actors'}){ $infobox->insert('end',"ACTORS: ",'tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'actors'}\n",'tagb');; }else{ $infobox->insert('end',"\n") } if(length $days{ $ch }{ $num }{'channel_info'}){ $infobox->insert('end','STATION: ','tagr'); $infobox->insert('end',$days{ $ch }{ $num }{'channel_info'},'tagb'); } if(length $days{ $ch }{ $num }{'episode_num'}){ $infobox->insert('end',' EPISODE: ','tagr'); $infobox->insert('end',"$days{ $ch }{ $num }{'episode_num'}\n",'tagb') +; } }); #--------------------------------------------------------------- MainLoop; ################################################################ sub clean_exit{ $shash{'die'} = 1; $shash{'thread'}->join; $dhash{'die'} = 1; $dhash{'thread'}->join; exit; } ################################################################# sub load_program{ #create program boxes my $d8 = shift || 0; if($d8 == $prev_sel){return}; #clear off screen $canvasp->delete($canvasp->find('withtag','info')); # clear out $days hash to prevent cross-linking foreach my $channel(@chs_orig){ foreach my $count(0..$max_prog_chan){ undef $days{$channel}{$count}{'channel'}; undef $days{$channel}{$count}{'channel_info'}; undef $days{$channel}{$count}{'episode_num'}; undef $days{$channel}{$count}{'start'}; undef $days{$channel}{$count}{'stop'}; undef $days{$channel}{$count}{'makedate'}; undef $days{$channel}{$count}{'description'}; undef $days{$channel}{$count}{'title'}; undef $days{$channel}{$count}{'writer'}; undef $days{$channel}{$count}{'director'}; undef $days{$channel}{$count}{'actors'}; undef $days{$channel}{$count}{'rating'}; undef $days{$channel}{$count}{'length'}; undef $days{$channel}{$count}{'category'}; undef $days{$channel}{$count}{'star_rating'}; } } #print Dumper([\$days{54} ]),"\n"; $shash{'day'} = $d8; #---get_xml--- $shash{'go'} = 1; #set previous selection $prev_sel = $d8; &run_progress(); my $timer; $timer = $mw->repeat(100,sub{ if(scalar @finished > 0){ my $done = shift @finished; # print Dumper([\$days{$done }]) load_tk_box($done); } if( $shash{'go'} == 0 ){ $timer->cancel; foreach my $done(@finished){ load_tk_box($done); } $image->stop_animation(); $infobox->delete('1.0','end'); } }); } ################################################################# sub load_tk_box{ my $channel = shift; my $slot = $slots{'flip'}{$channel}; #$days{$channel}{ $chan_count{$channel} }{'start'} = $start; foreach my $num( keys %{$days{$channel}} ){ next if( ! defined $days{$channel}{ $num }{'start'} ); my $start = $days{$channel}{ $num }{'start'}; my $stop = $days{$channel}{ $num }{'stop'}; my (@start) = split /:/, $start; my (@stop) = split /:/, $stop; if( $start[0] > $stop[0] ){ $stop[0] += 24 } my $startp = $start[0] * 300; my $stopp = $stop[0] * 300; $startp += $start[1] * 5; $stopp += $stop[1] * 5; my $textboxwidth = $stopp - $startp - 2; my $fill = 'snow'; if( length $days{$channel}{ $num }{'star_rating'} > 0 ){ $fill = 'corn +silk2'} $canvasp->createRectangle($startp, $slots{$slot}{'top'}, $stopp, $slo +ts{$slot}{'bottom'}, -width => 2, -fill =>$fill, -tags =>['info', $channel, $num], ); #check for squished text on long titles my $title1text = "$start[0]:$start[1] $days{$channel}{ $num }{'title +'}"; #check for squished text on 15 minute shows if($textboxwidth <= 73){ my @words=split(/\s+/,$title1text); @words = grep ! /the/i, @words; $title1text = "$words[0]\n$words[1]"; } if( ($textboxwidth <= 148) and ($textboxwidth >= 73) ) { my @words=split(/\s+/,$title1text); @words = grep ! /the/i, @words; $title1text = join ' ', @words; my $t1font_len = $canvasp->fontMeasure('medium', $title1text ) +; if( $t1font_len > ( 2 * $textboxwidth )){ do{ chop( $title1text ); $t1font_len = $canvasp->fontMeasure('medium', $title1text + ); }until( $t1font_len < ((2 * $textboxwidth) - $tfont_len) ); } } my $t1font_len = $canvasp->fontMeasure('medium', $title1text ); if( $t1font_len > ( 2 * $textboxwidth )){ do{ chop( $title1text ); $t1font_len = $canvasp->fontMeasure('medium', $title1text ); }until( $t1font_len < 2 * $textboxwidth ); } #topline $canvasp->createText($startp + 3, $slots{$slot}{'toptext'} , -text => $title1text, -font => 'medium', -fill => 'blue', -anchor => 'nw', -width => $textboxwidth, -tags =>['info', $channel, $num ,'text'], ); } } ###################################################################### +# sub xscrollit{ my $fraction = $_[1]; $canvast->xviewMoveto($fraction); $canvasp->xviewMoveto($fraction); } ###################################################################### + sub yscrollit{ my $fraction = $_[1]; $canvass->yviewMoveto($fraction); $canvasp->yviewMoveto($fraction); } #################################################################### sub get_time{ my $gettime = shift; my $date_string = localtime($gettime); my @split = split /\s+/, $date_string; my %months =( Jan=>'01', Feb=>'02', Mar=>'03', Apr=>'04', May=>'05', Jun=>'06' , Jul=>'07' , Aug=>'08' , Sep=>'09', Oct=>'10' , Nov=>'11' , Dec=>'12' ); my $ymd = $split[4].$months{ $split[1] }.sprintf('%.2d', $split[2] ) +; my $wday = "$split[0] $split[1] $split[2]"; my ($h,$m,undef) = split /:/,$split[3]; return($ymd,$wday,$h,$m); } ###################################################################### + sub d8_to_string{ my $daynum = shift; my @months = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my ($year, $month, $day) = unpack 'a4 a2 a2', $daynum; my @days = qw(Sun Mon Tue Wed Thu Fri Sat); my $dayname = $days[day_of_week($year,$month,$day)]; return("$dayname $months[$month-1] $day"); } #################################################################### sub day_of_week { my ($year, $month, $day) = @_; my @offset = (0, 3, 2, 5, 0, 3, 5, 1, 4, 6, 2, 4); $year -= $month < 3; return ($year + int($year/4) - int($year/100) + int($year/400) + $offset[$month-1] + $day) % 7; } ##############################################################3 sub fill_date_hashes{ my @dayxml = glob("$xml_dir/*.xmltv"); foreach my $dat(@dayxml){ my ($d8) = ($dat) =~ /.*(\d{8})\.xmltv$/; my $daystring = d8_to_string($d8); $dates_d8{$d8} = $daystring; $dates_str{$daystring} = $d8; } } ################################################################# sub get_day_choices{ my @choices = (); my ($ymd,$wday,$h,$m) = &get_time(time); #the %dates_d8 is easier to sort, so.... foreach my $key(sort keys %dates_d8){ if( $key >= $ymd){ push @choices, $dates_d8{$key}; }else{ #delete the old files my $filepath = "$xml_dir/tv-$key.xmltv"; unlink $filepath or warn "$!\n"; } } if(scalar @choices == 0){ my $dialog = $mw->DialogBox( -buttons => ['Ok'], -title => 'MESSAGE', -bg => 'lightsteelblue', ); $dialog->add('Label', -bg=>'yellow', -text=>'You need to Download Days')->pack(); $dialog->Show(); } return @choices; } ################################################################## sub run_progress{ $infobox->delete('1.0','end'); $infobox->insert('end',"\n\n\n\n\n Please wait while Loading XM +L data",'tagr'); $image->start_animation(40); } ################################################################ sub get_gif{ #base64encoded gif89a my $gif = 'R0lGODlhEAAQAPEEAAAAAP8AAP//AP///yH/C05FVFNDQVBFMi4wAwEAAAAh+QQFCgAEA +CwAAAAA EAAQAAADPki63B4wOhWrZFYEfWm2SwCMZDkGiglsajqU2viOablBJkVCnHhSGoFgYBGhgM +Me7ugR KlfM0DPaqKwmWEcCACH5BAUKAAQALAEAAAAPAA8AAAM8SKrR+ysA0CokM1cXwcjUxoCZYF +oNOZ1O BQqTGAiVScebMOwnWdsuj6ZB26gYmxQJmZRkIE5j4EKQJB8JACH5BAUKAAQALAEAAQAOAA +4AAAM3 SBoMzioy4cYLMojgOsOTQHXAFw4baZ7NtYap9prU1ryezZnqR+wcgKXU+O1IRMwi2ItkPE +pCAgAh +QQFCgAEACwBAAEADwAPAAADO0ga3KyQNEEZCHGKYYFfzhZ4wHBJFyOSJOGFAvs6aszSMI +nfnrDL gMpjRDJdhBjUjRaRMSOuWQOaeVATACH5BAUKAAQALAEAAQAOAA4AAAM2SBoB/Coy9wST7Q +XB79Tb 0H2gaFkNQG2TmqqUBc/A4AqzTQMy/e4wEAMFImhOxYUQEiGsNJEEACH5BAUKAAQALAAAAQ +APAA8A AAM8SErRDW2tAB2o8l7Hg9Ja5xDgxgnWNZiB4KIP2ApDDafzjTKpIEcOV8nEyw0hig5o5Z +lwSpLk Exl1RiQJACH5BAUKAAQALAEAAQAOAA4AAAM4SBoBzkFJ5ipgk9qGrx4PB2khBQlNCXmBAK +BjjF5C HY8VM9jxJuywlaUGIwhzxUUK9MJIjCmWJAEAIfkEBQoABAAsAAAAAA8ADwAAAz1IutGxUL +kGaiQz 1A2z3sCDNYLwDeDjlODmCdUXZ1vpOa3ttYBOAQReYGCiqACoGDGjSA19nVCgVBR1bosEAD +s='; return $gif; } ####################################################################3 sub get_gif1{ #base64encoded gif89a my $gif = 'R0lGODlhIAAgAPIFAC4uLlVVVYWFheXl5ff39wAAAAAAAAAAACH/C05FVFNDQVBFMi4wA +wEAAAAh +QQFZAAFACwAAAAAIAAgAAADVwi63P4wykmrXYPoPcJ1WygKH5CJ6HalrEq1MDGd4eAIqY +Tqovfs EyAo5AsSbyJLINnorUJDl4XJoEoE2BG21GRxo9AvWCb+acoRMnrNbrvf8Lh8Tq+3EwAh+Q +QEZAD/ ACwDAAMAHQAdAAADVwi6vPSiyTmfJTTLa4f+3PVloThSQemdaMhq7ktxMjVca93Q+m72jh +8QwBsS hcAiUIAzHi0BWYQRYxGmihB2BFGkqtySEiRGwsqWGjqqK7GTVyd1K6drEgAh+QQEZAD/AC +wAAAMA HQAdAAADUgi63P4wykmrvTjrzbsjXkOMoTKe4al2arsJcAsLlWuulw3oVKC3AYts4cNNii +hGCzRZ NpBJiPOzpDUGy4F0yZ1uu10KOGsRjEmZALalLbnfnAQAIfkEBGQA/wAsAAAAAB0AHQAAA1 +cIutzS MEolyLyyWnwD+eDGNV5ojoypfiiwqu17omtAsagWMlXrzotHqwTyRQYhoTG1WzaATgU0On +VWl1cj EjSIMoteadansnm3JrNVRn2dV+FfM64bJQAAOw=='; return $gif; } ################################################################### sub do_download{ my $dialog = $mw->DialogBox( -buttons => [qw/Ok Cancel/], -bg => => 'lightsteelblue', -title => "Enter New Value" ); $dialog->add('Label', -bg => 'lightsteelblue', -fg => 'yellow', -font => 'big', -text => "Get how many days forward?\n8 is 1 week ahead")->pack +(); my @options = (1..15); # 2 weeks my $selectnum = $options[0]; my $dialogOM = $dialog->add("Optionmenu", -bg => 'black', -fg => 'green', -font => 'big', -width => 20, -options => \@options, -textvariable => \$selectnum, )->pack(); ## Determine whether or not the user hit "Ok" my $button = $dialog->Show(); if ( $button eq "Ok" ) { @finished_down=(); #reset shared arrays @to_download =(); #now compute the d8 value for each offset foreach my $offset(0..$selectnum - 1){ #86400 seconds per day my $seconds = time + $offset*86400; my ($ymd,undef,undef,undef) = get_time($seconds); if( -e "$xml_dir/tv-$ymd.xmltv"){ next } #skip files we alread +y have else{ #start download animation $image1->start_animation(); $dhash{'progress'} = 1; #set the animation flag to on push @to_download, $offset; push @to_download, $ymd; } $dhash{'go'} = 1; #the thread should start downloading now #popup toplevel for monitoring download messages $top->deiconify; $top->raise; my $texttimer; $texttimer = $mw->repeat(100,sub{ $mtext->delete('1.0','end'); $mtext->insert('end', $dhash{'output'} ); #check for online connection if( $dhash{'output'} =~ /.*Bad hostname.*/ ){ for(1..3){ $mtext->insert('end', "\n\n!!!!! Please go online, or se +rver is down !!!!!\n"); } $image1->stop_animation(); } if( $dhash{'progress'} == 0 ){ $texttimer->cancel; $mtext->delete('1.0','end'); # $top->withdraw; } }); #now watch for finished files my $filetimer; $filetimer= $mw->repeat(100,sub{ if( scalar @finished_down > 0){ my $donefile = shift @finished_down; &fill_date_hashes; my @opts = get_day_choices(); $om->configure(-options =>\@opts); if(! $screen_set){ $screen_set = 1; #set loaded flag &load_program( $donefile ); } } if( $dhash{'go'} == 0 ){ $filetimer->cancel; foreach my $donefile(@finished_down){ print "shifted $donefile download done\n\n"; &fill_date_hashes; my @opts = get_day_choices(); $om->configure(-options =>\@opts); } $image1->stop_animation(); } }); }#end of download files foreach } #end of if OK } ################################################################### ################### xml Thread code below ######################### ################################################################### sub xmlwork{ $|++; use XML::Simple; while(1){ if($shash{'die'} == 1){ goto END }; if ( $shash{'go'} == 1 ){ # print "starting xml\n"; &get_xml_file(); # print "\n\ndone xml\n"; if($shash{'go'} == 0){last} if($shash{'die'} == 1){ goto END }; #after above processing is done $shash{'go'} = 0; #turn off self before returning }else { sleep 1 } } #------------------------------------------------------------ sub get_xml_file{ my $xmlfile = $shash{'xmldir'}.'/tv-'.$shash{'day'}.'.xmltv'; my %chan_count; my $xs = new XML::Simple(); # Reference to xml object my $ref= $xs->XMLin($xmlfile ); my %channels; my $last_channel = 0; #-------start looping thru keys--------------------------------- foreach my $key(keys %{$ref}){ #---- translation from zap2it channel local channel numbers------- if($key eq 'channel'){ foreach my $labchannel(keys %{ $ref->{$key} } ){ $channels{$labchannel}{'chan_num'}= "$ref->{$key}->{$labchannel}->{'display-name'}->[2]"; $channels{$labchannel}{'chan_desc'}= "$ref->{$key}->{$labchannel}->{'display-name'}->[3] ". "$ref->{$key}->{$labchannel}->{'display-name'}->[4]"; } } #----------------end channel translation---------------------------- #------start loop thru all programs-------------------------- #zero out program counter for each channel foreach my $channel( $shash{'channels'} ){ $chan_count{$channel} = 0; } if($key eq 'programme'){ foreach my $pkey( @{ $ref->{$key} } ){ do{ warn "Graceful exit!\n"; exit } if $EXIT; #---------get translated channel info of program----------- my $channel = $channels{ $pkey->{'channel'} }{'chan_num'}; my $channel_info = $channels{ $pkey->{'channel'} }{'chan_desc'}; #------------------end channel info------------------------- $chan_count{$channel}++; my $title = $pkey->{'title'}->{'content'}; #----------------end title----------------------- my $episode_num; if(defined $pkey->{'episode-num'}){ if(ref $pkey->{'episode-num'} eq 'HASH'){ $episode_num = $pkey->{'episode-num'}->{'content'}; } if(ref $pkey->{'episode-num'} eq 'ARRAY'){ $episode_num = $pkey->{'episode-num'}->[0]->{'content'}; if($episode_num =~ /^\.\..*/){ #check for ..0/2 ..1/2 gli +tch $episode_num = $pkey->{'episode-num'}->[1]->{'content'}; } } } #----------------end episode-num--------------- my ($day,$start) = convert2local($pkey->{'start'}); my (undef,$stop) = convert2local($pkey->{'stop'}); #----------------end start/stop---------------- my $makedate = ''; if(defined $pkey->{'date'}){ $makedate = $pkey->{'date'}; } #----------------end makedate---------------------- my $description = ''; if(defined $pkey->{'desc'}){ $description = $pkey->{'desc'}->{'content'}; } #----------------end description-------------------- my $writer = ''; my $director = ''; my @actors = (); if(defined $pkey->{'credits'}){ if(defined $pkey->{'credits'}->{'writer'}){ if(ref $pkey->{'credits'}->{'writer'} eq 'ARRAY'){ my @writers = @{ $pkey->{'credits'}->{'writer'} }; $writer = $writers[0]; }else{ $writer = $pkey->{'credits'}->{'writer'} }; } if(defined $pkey->{'credits'}->{'director'}){ if(ref $pkey->{'credits'}->{'director'} eq 'ARRAY'){ my @directors = @{ $pkey->{'credits'}->{'director'} }; $director = $directors[0]; }else{ $director = $pkey->{'credits'}->{'director'} }; } if(defined $pkey->{'credits'}->{'actor'}){ if(ref $pkey->{'credits'}->{'actor'} eq 'ARRAY'){ @actors = @{ $pkey->{'credits'}->{'actor'} }; }else{ @actors = $pkey->{'credits'}->{'actor'} }; } } #-------------------end credits---------------------------- my $rating = ''; if(defined $pkey->{'rating'}){ if(ref $pkey->{'rating'} eq 'HASH'){ $rating = $pkey->{'rating'}->{'value'}; } if(ref $pkey->{'rating'} eq 'ARRAY'){ foreach my $href( @{ $pkey->{'rating'} } ){ # print $href->{'value'},"\n"; $rating .= "$href->{'value'} "; } } } #--------------end rating-------------------------- my $length = ''; if(defined $pkey->{'length'}){ $length = $pkey->{'length'}->{'content'} . $pkey->{'length'}->{'uni +ts'}; } #---------------end length---------------------------- my $category = ''; if(defined $pkey->{'category'}){ if(ref $pkey->{'category'} eq 'HASH'){ $category = $pkey->{'category'}->{'content'}; } if(ref $pkey->{'category'} eq 'ARRAY'){ foreach my $href( @{ $pkey->{'category'} } ){ # print $href->{'value'},"\n"; $category .= "$href->{'content'} "; } } } #--------------end category-------------------------- my $star_rating = ''; if(defined $pkey->{'star-rating'}){ $star_rating = $pkey->{'star-rating'}->{'value'}; } #-------------end star-rating----------------------- #-------------setup %day hash---------------------- if(( $chan_count{$channel} == 1) and ($last_channel > 0)){ push @finished, $last_channel; } $days{$channel}{ $chan_count{$channel} }{'channel'} = $channel; $days{$channel}{ $chan_count{$channel} }{'channel_info'} = $channel_in +fo; $days{$channel}{ $chan_count{$channel} }{'episode_num'} = $episode_num +; $days{$channel}{ $chan_count{$channel} }{'start'} = $start; $days{$channel}{ $chan_count{$channel} }{'stop'} = $stop; $days{$channel}{ $chan_count{$channel} }{'makedate'} = $makedate; $days{$channel}{ $chan_count{$channel} }{'title'} = $title || 'No Titl +e'; $days{$channel}{ $chan_count{$channel} }{'description'} = $description +; $days{$channel}{ $chan_count{$channel} }{'writer'} = $writer; $days{$channel}{ $chan_count{$channel} }{'director'} = $director; $days{$channel}{ $chan_count{$channel} }{'actors'} = join ' ',@actors; $days{$channel}{ $chan_count{$channel} }{'rating'} = $rating; $days{$channel}{ $chan_count{$channel} }{'length'} = $length; $days{$channel}{ $chan_count{$channel} }{'category'} = $category; $days{$channel}{ $chan_count{$channel} }{'star_rating'} = $star_rating +; $last_channel = $channel; }#-------------end %day hash setup------------------ push @finished, $last_channel; #get last one left over } #-----end of each channel } #----------End of programme loop------------------------- #test dump #print Dumper([\$days{54}]),"\n"; #clean up $xs = (); undef $xs; %{$ref} = (); undef %{$ref}; } #----------end of get_xml_file-------------------------------------- ############################################################# sub convert2local{ my $date_str_in = shift; my ($y,$mn,$d,$h,$m,$s) = ($date_str_in) =~ /(\d{4})(\d{2})(\d{2})(\ +d{2})(\d{2})(\d{2}).*/; my $day = "$y-$mn-$d"; my $time = "$h:$m"; #print "$date_str_in $day $time\n"; return ($day ,$time); } ################################################################## END: #end of thread code block } ##################################################################### ##################################################################### ##################################################################### ################# downloader thread below ########################### ##################################################################### ##################################################################### sub downthread{ use IO::Select; $|++; my $xml_dir = $dhash{'xmldir'}; my $config = $dhash{'config_loc'}; my $sel = new IO::Select(); while(1){ if($dhash{'die'} == 1){ goto END }; if ( $dhash{'go'} == 1 ){ while (scalar @to_download > 0){ my $offset = shift @to_download; my $ymd = shift @to_download; $dhash{'output'} = ''; #clean out last run's results $dhash{'output'} .= "########### starting download for $ym +d ###########\n\n"; my @opts= ("--config-file $config","--offset $offset",'--days 1', "--o +utput $xml_dir/tv-$ymd.xmltv"); #print "@opts\n"; #system("tv_grab_na_dd @opts") or warn "$!\n"; open(OH,"tv_grab_na_dd @opts 2>&1 |") or warn "$!\n"; $sel->add(\*OH); while ( $sel->can_read() ) { foreach my $h ( $sel->can_read() ) { my $buf = ''; sysread(OH,$buf,512); if($buf){ $dhash{'output'} .= $buf; if( $dhash{'output'} =~ /.*Downloaded.*/ ){ goto CLOSE } } if($dhash{'go'} == 0){last} if($dhash{'die'} == 1){ goto END }; } } CLOSE: $sel->remove(\*OH); close OH; push @finished_down, $ymd; if($dhash{'go'} == 0){last} if($dhash{'die'} == 1){ goto END }; } #after above processing is done $dhash{'progress'} = 0; $dhash{'go'} = 0; #turn off self before returning }else { sleep 1 } } END: #end of downloader thread block } #------------------------------------------------------------ ###################################################################### +## __END__

In reply to ztk-tvguide by zentara

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or How to display code and escape characters are good places to start.
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others taking refuge in the Monastery: (2)
As of 2024-04-25 03:48 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found