Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

ztk-tvguide

by zentara (Archbishop)
on Sep 15, 2005 at 15:39 UTC ( [id://492288]=sourcecode: print w/replies, xml ) Need Help??
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__
Replies are listed 'Best First'.
Re: ztk-tvguide
by b10m (Vicar) on Sep 15, 2005 at 15:59 UTC

    Nice, yet FreeGuide looks a little easier to browse with ...

    --
    b10m

    All code is usually tested, but rarely trusted.
[reply]
      Yeah but FreeGuide takes a whopping 276 megs of virtual memory on my system, loading all that java, and it dosn't let you browse while downloading. It is also slower to load, since it loads more than 1 day, before it even pops up for business.
      I'm not really a human, but I play one on earth. flash japh
[reply]
      As an after thought, what do you think makes FreeGuide easier to use? About the only realtime advantage I see, is it smoothly merges midnight of 1 day, into the next giving you a full 24 hour sliding window. Where my script, just gives you what programs start that static day, and you need to select from the optionmenu for the next day. Just like a real tv guide, :-).

      9 times out of 10, I just want to see that day anyways, at the time I run it.

      I intend to add favorites, and printouts in my next version :-).

      I'm not really a human, but I play one on earth. flash japh
[reply]

        I know, I know, Java sucks pretty bad for this TV Guide stuff, yet the GUI is friendlier and more intuitive, or so it looks... maybe I get used to ztk-tvguide's GUI soon ;)

        --
        b10m

        All code is usually tested, but rarely trusted.
[reply]
Re: ztk-tvguide
by liverpole (Monsignor) on Sep 16, 2005 at 02:39 UTC
    Really, really nice, zentara!  This is an example of combining creative thinking with creative coding to come up with something extremely useful!
[reply]
      Hi, thanks. Please download it again. I needed to change the UTC-2-local conversion method, and just let the xmltv grabber script do it. So in your xmltv configuration file, you need to change

      timezone UTC

      to

      timezone -0400

      (for N.America ESTDST).

      I'm finding a few bugs as I go along. :-) Since I'm the only one testing it, I can only find the ones that pop out at me. I found the above bug, by noticing a slight mismatch between my script's output, and the output of freeguide. ;-)

      I'm not really a human, but I play one on earth. flash japh
[reply]
Re: ztk-tvguide
by Arunbear (Prior) on Sep 16, 2005 at 16:34 UTC
    Apart from the screenshot, the rest is text. Couldn't you just post it here?
[reply]
      Yeah I coulld, but I'm making changes to the script as I refine it, and don't want to go thru all the trouble of cut'n'pasting new versions into the code box. The downloadable file always has the latest bugfixes and updates. But I will put my latest version in here.
      I'm not really a human, but I play one on earth. flash japh
[reply]
Re: ztk-tvguide
by zentara (Archbishop) on Sep 26, 2005 at 19:23 UTC
    A bugfix version 2a is now on the download site. See the bugfixes for changes. I'm trying to make sure it runs on Windows as well as Linux. The last big obstacle is finding a replacement for Proc::Killfam, to be used on Windows, and a minor problem with font size changes.
    I'm not really a human, but I play one on earth. flash japh
[reply]
Re: ztk-tvguide
by zentara (Archbishop) on Jul 15, 2007 at 11:57 UTC
    There is hope yet. A group of free software developers want to have a replacement for zap2itlabs before they shut down their feed. See: Easy TV Data
    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]
Re: ztk-tvguide
by zentara (Archbishop) on Jun 21, 2007 at 11:48 UTC
    Sorry, but it seems that zap2itlabs will be discontinuing it's free tvguide service in September.... see slashdot article

    So at that point, this software (and many similar ones) will be useless.

    I'm not really a human, but I play one on earth. Cogito ergo sum a bum
[reply]

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://492288]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others musing on the Monastery: (4)
As of 2024-04-18 04:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found