#!/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__
|