http://qs321.pair.com?node_id=492288
Category: GUI Programming
Author/Contact Info zentara@zentara.net
Description: Perl/Tk frontend to the xmltv listings available from http://labs.zap2it.com. screenshot

Download: Download

UPDATE: ( 5 hours after post) I fixed a small bug which could cause cross-linking of entries across days. I had to undef all shared hash values before each run. So please download again.

UPDATE2: I found a bug in my UTC to localtime conversion. So I switched from UTC time. Please download again it if you are testing it, and notice any time listing errors. I'm the only one testing this, and I update the tarball as I notice, find and fix the bugs. :-)

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