/usr/bin/tv

#!/usr/bin/perl -w
#
# tv_check
#
# This script searches a channel GUIDE for shows in a show list and alerts when
# a listed show is missing from its time slot, or shows up at other days or times.
#
# The show list is a custom XML format.
# The channel guide needs to be in XMLTV format.
#
# for details, see Usage below
#
# (C)2001 - Robert Eden, free to use under the GNU License.
#
#  Robert Eden - reden@cpan.org
#
#     See cvs logs entries for module history
#
#

=pod

=head1 NAME

tv_check - Check TV guide listings

=head1 SYNOPSIS

tv_check --configure|--scan [other options]

=head1 DESCRIPTIONS

tv_check is a Perl script that reads in a file with show information
and checks it against a TV guide listing, reporting on upcoming episodes
and alerting you to unexpected episodes or schedule changes.

=head1 OPTIONS

B<--configure> Run configuration GUI.  Either this option or --scan must be
provided.

B<--season-reset> special --configure option to remove everything but the title to
help new season setup.  The idea is to keep everything a "title-only" search
until seasons begin. Then you update the details including record device. *expirimental*

B<--scan> Scan TV listings.  Either this option or --configure must be provided.

B<--myreplaytv=UNIT,USERNAME,PASSWORD> ** Feature removed ** This option used to
auto-populate a config file based on myreplaytv.com.


B<--shows=FILE> Specify the name of XML shows file (default: shows.xml).

B<--guide=FILE>, B<--listings=FILE> Specify the name of XML guide file
(default: guide.xml).

B<--html> Generate output in HTML format.

B<--bluenew> Highlights new episodes in blue (helpful back when there was an off-season)

B<--output=FILE> Write to FILE rather than standard output

B<--help> Provide a usage/help listing.

=head1 SEE ALSO

L<xmltv(5)>.

=head1 AUTHOR

Robert Eden; manpage by Kenneth J. Pronovici.

=cut

use strict;
use XMLTV::Version '$Id: tv_check,v 1.77 2015/07/12 00:46:37 knowledgejunkie Exp $ ';

use Tk;
use Tk::TableMatrix;
use XML::Twig;
use Date::Manip;
use Time::Local;
use Data::Dumper;
use Getopt::Long;
## use HTTP::Cookies;
## use HTTP::Request::Common qw(POST GET);
## use LWP::UserAgent;
use XMLTV qw(best_name);
use XMLTV::Date;
use XMLTV::Usage
' tv_check v $Revision: 1.77 $ ' . <<END

 part of the xmltv toolkit ( http://xmltv.sourceforge.net )

usage $0 (--configure|--scan) [--options] [--output=file] [--html]
where --options are:
   --shows <file>
     xml files with show info (default shows.xml )

   --listings <file>
     xml files with guide info (default guide.xml )

   --configure
     run configuration GUI instead of checking listings

   --html
     scan output is in HTML format

   --ddmm
     prints DDMM date instead of MMDD in reports

   --days n
     process n days (default 7)

   --notruncate
     don't exclude episodes before today in extra-episode scans
     don't exclude episodes after '--days' days in extra-episode scans

   --season-reset
     special --configure option to remove everything but the title to
      help new season setup.  The idea is to keep everything a "title-only" search
      until its season begins, then add the details including recording device. *experimental*

END
  ;

#
# Define constants
#
select STDERR; $|=1;
select STDOUT; $|=1;
$ENV{TZ}='UTC' unless exists $ENV{TZ};
my @WEEKDAY  = qw (Sun Mon Tue Wed Thu Fri Sat);
my $WEEKDAY  = "SunMonTueWedThuFriSat   ";
my $R_ON     = ""; # used for HTML output
my $G_ON     = ""; # used for HTML output
my $B_ON     = "";
my $N_ON     = "";
my $OFF      = "";
#    COL_TYPE  1:List 2:Entry 3:checkbox
my @COL       = qw(device day channel hhmm len title chanonly dayonly timeonly neartime );
my %COL;
   $COL{$COL[$_]}=$_ foreach (0..$#COL);  # populate $COL reverse hash

my @COL_TYPE  = qw(1      1         1    2   2     1       3       3         3        3 );

my $CONFIGURE= 0;
my $HTML     = 0;
my $DDMM     = 0;
my $DAYS     = 7;
my $NOTRUNCATE = 0;
my $BLUENEW   = 0;
my $SEASON_RESET =0;
my $GUIDE_XML= 'guide.xml';
my $SHOW_XML = 'shows.xml';
my $OUTPUT_FILE = undef;
my $TODAY      = $WEEKDAY[(localtime())[6]];
(my $TODAY_MMDD)= UnixDate( "Now", "%Y%m%d");
(my $WEEK_MMDD) = UnixDate( "$DAYS days later", "%Y%m%d");
(my $TWOM_MMDD) = UnixDate( "2 months ago", "%Y%m%d");

#
# Global Vars/Databases
#
my @SHOWS        = (); # raw show data
my $SHOW_TABLE   = ""; # stores pointer to SHOW_TABLE
my @SHOW_DATA    = (); # pointer to raw by SHOW_TABLE row
my %SHOW_DATA    = (); # data for SHOW_TABLE
my %SHOW_WIDTH   = (); # column widths for SHOW_TABLE
my %SHOW_TIME;         # order of shows for report
my %OLD_SHOW;          # {old_title}=[show entryies]
my %MIDNIGHTS    = (); # {day}[] Holds midnights for each future day of the week

my @MYREPLAY_LIST = ();
my $MYREPLAY_UNIT = "";  # parameters for MYREPLAY fetch
my $MYREPLAY_USER = "";
my $MYREPLAY_PASS = "";
my $MYREPLAY_NONG = "";
my $MYREPLAY_DEBUG = "";  # 0=ignore, 1=save to replay.html, 2=load from replay.html


my $SHOW_CHANGED = 0;  # updd if show needs to be saved
my $SHOW_SORT    = $COL{title};  # column to sort SHOW_TABLE
my $SHOW_ROW     = 0;  # last selected row

#
# Episode data is comes from XMLTV, but data is added to the hash
# for our own use.  Since we never write out the Episode XLM, this is ok.
# The following non XMLTV fields are used
#   {prev} = pointer to previous episode on channel
#   {next} = pointer to next episode on channel
#   {device} = device that will record this episode
#   {hhmm} = start time     ( computed on demand or if $CONFIGURE)
#   {day}  = start day      ( computed on demand or if $CONFIGURE)
#   {mmdd} = start date     ( computed on demand or if $CONFIGURE)
#   {len } = episode length ( computed on demand or if $CONFIGURE)


my @GUIDE     = ();    # episode list
my %GUIDE     = ();    # episode indexes
#
# Episode Indexes ( CAPS are constants )
#
#  $GUIDE{ALL}{title}=[ep...]
#  $GUIDE{chan}{binstart}=$ep
#  $GUIDE{starts}{chan}=[all-start-times];
#
# The following indexes are only used by configure mode
#                                          array=[day,channel,hhmm,len]
#  $GUIDE{TITLE}{title}     =[ [day,chan,hhmm,len]...]
#  $GUIDE{CHAN}{chan}{title}=[ [day,chan,hhmm,len]...]
#  $GUIDE{DAY}{day}{title}  =[ [day,chan,hhmm,len]...]
#  $GUIDE{day}{chan}{title} =[ [day,chan,hhmm,len]...] This works since day!=chan.  I hope :)
#
my $ENCODING;          # character encoding for listings data

my @CHAN      = ();    # channel list (sorted)
my %CHAN      = ();    # channel list ( channel-id key )
my %CHAN_NAME = ();    # channel list ( display-name key )

my %SELECT    = ();    # array of selector widgits

my %RECORD    = ();    # hash of shows to record (conflict check)
my %DEVICE    = ();    # list of recording devices ( hash to avoid dupes )

my $ADD_BUTTON;
my $DELETE_BUTTON;
my $UPDATE_BUTTON;
my $CLEAR_BUTTON;
my $TOP;
my @LANG         = ();    # preferred languages

my @COL_VALUE=();
$COL_VALUE[$_] = "" foreach (0..$#COL);

#
# Step 1, Parse Parameters -------------------------------------------------------
#
# First lets check to see if someone asked for help.
# this is easier to do here than later.
{
    my $scan=0;
    my $help=0;
    my $myreplayargs;
    GetOptions('configure'    => \$CONFIGURE,
	       'scan'             => \$scan,
	       'myreplaytv=s'     => \@MYREPLAY_LIST,
	       'html'             => \$HTML,
	       'shows=s'          => \$SHOW_XML,
	       'output=s'         => \$OUTPUT_FILE,
	       'guide|listings=s' => \$GUIDE_XML,
   	       'ddmm'             => \$DDMM,
   	       'days=i'           => \$DAYS,
   	       'notruncate'       => \$NOTRUNCATE,
 	       'bluenew'          => \$BLUENEW,
               'season-reset'     => \$SEASON_RESET,
	       'help'             => \$help)
      or usage();
    usage(1) if $help;

    die "Please select either --scan, --configure, or --help\n" if ($CONFIGURE+$scan != 1);
    if (defined $OUTPUT_FILE)
    {
           print STDERR "Sending output to $OUTPUT_FILE\n";
           open(STDOUT,">$OUTPUT_FILE") or die "Can't open for output $OUTPUT_FILE\n";
    }

    foreach (@MYREPLAY_LIST)
    {
        ($MYREPLAY_UNIT,$MYREPLAY_USER,$MYREPLAY_PASS,$MYREPLAY_NONG,$MYREPLAY_DEBUG)=split(/,/,$_);
        die "MYREPLAY UNIT not specified\n" unless length($MYREPLAY_UNIT)>0;
        die "MYREPLAY USER not specified\n" unless length($MYREPLAY_USER)>0;
        die "MYREPLAY PASS not specified\n" unless length($MYREPLAY_PASS)>0;
    }

} # get params

load_guide($GUIDE_XML);
load_shows($SHOW_XML);

### ----------------------------------------
### do we need to get shows from MYREPLAYTV?
###
### disabled, since myreplaytv.com doesn't exist any more!
###
###
##if (@MYREPLAY_LIST) {
##    print STDERR "**WARNING** Replay has discontinued the MyReplayTV service. Ignoring -myreplay\n";
##}
### foreach (@MYREPLAY_LIST) {
##if (0) {
##    $MYREPLAY_UNIT=$MYREPLAY_USER=$MYREPLAY_PASS=$MYREPLAY_NONG=$MYREPLAY_DEBUG=undef;
##    ($MYREPLAY_UNIT,$MYREPLAY_USER,$MYREPLAY_PASS,$MYREPLAY_NONG,$MYREPLAY_DEBUG)=split(/,/,$_);
##    $MYREPLAY_NONG=0  unless defined $MYREPLAY_NONG;
##    $MYREPLAY_DEBUG=0 unless defined $MYREPLAY_DEBUG;
##
##    my $html="";
##    my $device="MyReplayTV$MYREPLAY_UNIT";
##
###
### remove existing MYREPLAY_UNIT entries (they will be loaded fresh later)
###
##    for my $show (@SHOWS)
##    {
##         if (defined $MYREPLAY_UNIT and $show->{device} eq "MyReplayTV$MYREPLAY_UNIT")
##        {
##	        push @{$OLD_SHOW{$show->{title}}},$show; # quick hack to save previous options
##            $show->{title}='';
##        }
##    }
##
##    print STDERR "Fetching shows from $device\n";
##
##if ($MYREPLAY_DEBUG != 2)
##{
###
### create user agent
###
##    my $ua = LWP::UserAgent->new;
##       $ua->cookie_jar( HTTP::Cookies->new);
##       $ua->agent("tv_check/1.0" . $ua->agent);
##
###
### login to MyReplayTV
###
###   print STDERR "MyReplayTV logging in\n";
##    my $res = $ua->request(POST 'http://my.replaytv.com/servlet/Login',
##                          [ username => $MYREPLAY_USER,
##                            password => $MYREPLAY_PASS,
##         		            savePassword => '',
##                          ]);
##
##    unless ( $res->is_success && $res->title eq 'ReplayGuideRecordings' )
##    {
##       open(FILE,">error.html") && print(FILE $res -> as_string);
##       die "MyReplayTV login error!. Debug info in 'error.html'\n";
##    }
##
###
### get MyReplayTV show info
###
##    sleep 5;
###    print STDERR "MyReplayTV getting Replay Channels\n";
##    $res = $ua->request( GET('http://my.replaytv.com/servlet/ReplayGuideRequests',
##                              HTTP::Headers->new(
##                                  Referer => 'http://my.replaytv.com/servlet/ReplayGuideRecordings'
##                         )));
##
##    unless ($res->is_success && $res->title eq 'Replay Guide Shows')
##    {
##       open(FILE,">error.html") && print(FILE $res -> as_string);
##       die "MyReplayTV show fetch error. Debug info in 'error.html'\n";
##    }
##
###
### debug save (to make things faster and not overload Replay's servers during debug)
###
##    if ($MYREPLAY_DEBUG == 1)
##    {
##        open(FILE,">replay_$MYREPLAY_UNIT.html");
##        print FILE $res -> as_string;
##        close FILE;
##    }
##    $html=$res->as_string;
##}
##else
##{
##    open(FILE,"<replay_$MYREPLAY_UNIT.html") || die "Can't open relpay_$MYREPLAY_UNIT.html";
##    $html = join("\n",<FILE>);
##    close FILE;
##} # quick debug hack
##
###
### Got the listings... find our shows
###
##foreach (split(/\n/,$html))
##{
##	s/\s+/ /g;
##	next unless length($_)>5;
##        next if /was scheduled to record/;
##        next if /Nothing else is scheduled to record/;
##
##      if (my @a= / This show.+current episode.s. of (.+) occurring every \((.+)\) on Channel (\d+)\((.+)\).+ (\d+):(\d+)(\w). - (\d+):(\d+)(\w).+\. (.+) at /)
##      {
##
##      $a[4]  = "0"             if ($a[4]==12 and $a[6] eq 'A');  # midnight -> 00;
##      $a[7]  = "0"             if ($a[7]==12 and $a[9] eq 'A');  # midnight -> 00;
##
##      my $title = $a[0]; $title =~ s/\x92/'/g;  # fix illegal character in Replay Feed '
##      my $days  = $a[1];
##      my $chan  = "$a[2] $a[3]";
##      my $hhmm  = sprintf("%02d%02d",(($a[6] eq 'P') && ($a[4] != 12) ? $a[4]+12 : $a[4]),$a[5]);
##      my $stop  = sprintf("%02d%02d",(($a[9] eq 'P') && ($a[7] != 12) ? $a[7]+12 : $a[7]),$a[8]);
##      my $guar  = ( $a[10] =~ /^Not/ ? 0 : 1 );
##
##      next unless $guar || $MYREPLAY_NONG;
##
##    my $len   = hhmm_min($stop) - hhmm_min($hhmm);
##    $len += 24*60 if $len < 0;
##
##
##print STDERR "\nMyReplay looking for ",join("|",$title,$chan,$hhmm,$len,$days),"\n" if ($MYREPLAY_DEBUG == 2);
##
###
### convert channel ID to new format if ncessary
###
##       if ( ! exists $CHAN{$chan} && exists $CHAN_NAME{$chan} )
##       {
##          $chan=$CHAN_NAME{$chan};
##       }
##
###
### Check Channel
###
##      unless ( exists $CHAN{$chan})
##      {
##          print STDERR "MyReplayTV Channel '$chan' not in guide\n";
##          $CHAN{$chan}{'display-name'}[0][0]=$chan;
##      }
##
###
### if Replay expects our show on a specific day, we can just add it
###
##      if (length($days) == 3)
##      {
##        add_myreplaytv_show($title,$chan,$hhmm,$len,$days);
##        next;
##      }
##
###
### Now this gets tricky.  MyReplayTV tells us the time of a show, but not
### the day.  We can't assume the show is available for all days listed
### because that would cause too many false alarms in tv_check
###
### We can't use any day the show is on because of syndication.  A 2am
### Daily showing of a weekly show would also cause false alarms.
###
### So, the solution is to find the episode 2 slots back and 2 slots forward.
### If the MyReplay hhmm start time is between these values, record the day.
###
### This will cause problems around midnight.  I don't have a good solution there
###
### Personally, I now set all shows to record on a single day on the Replay, and
### if you specify a single day, this check isn't done... there's you're work-around!
###
##      my $found="";
##      for my $ep (@{$GUIDE{all}{lc($title)}})
##      {
##        gen_episode_dates($ep)    unless $ep->{day};
##    	my $day  = $ep->{day};
##
##        next if $chan ne $ep->{channel};
##        next if $days !~ /$day/;    	# episode on of myreplay's days?
##        next if $found =~ /:$day/;      # already got this day?
##
###
### get start time 2 slots back
###
##        my ($ep1,$ep2,$wstart,$wstop);
##        $ep1= $ep;
##        $ep1 =$ep1->{prev} if $ep1->{prev};
##        gen_episode_dates($ep1) unless $ep1->{day};
##
##        $ep2= $ep1;
##        $ep2 =$ep2->{prev} if $ep2->{prev};
##        gen_episode_dates($ep2) unless $ep2->{day};
##
##        $wstart=$ep ->{hhmm};
##        $wstart=$ep1->{hhmm} if $ep1->{day} eq $day;
##        $wstart=$ep2->{hhmm} if $ep2->{day} eq $day;
##
##
###
### Now start time 2 slots forward
###
##        $ep1= $ep;
##        $ep1 =$ep1->{next} if $ep1->{next};
##        gen_episode_dates($ep1) unless $ep1->{day};
##
##        $ep2= $ep1;
##        $ep2 =$ep2->{next} if $ep2->{next};
##        gen_episode_dates($ep2) unless $ep2->{day};
##
##        $wstop=$ep ->{hhmm};
##        $wstop=$ep1->{hhmm} if $ep1->{day} eq $day;
##        $wstop=$ep2->{hhmm} if $ep2->{day} eq $day;
##
##
##printf STDERR "day search: %s: %s<%s<%s\n",$title,$wstart,$hhmm,$wstop if $MYREPLAY_DEBUG > 1;
##
###
### record the day if MyReplay start time is between these times
###
##        next if $hhmm lt $wstart;
##        next if $hhmm gt $wstop;
##
###
### guess it's a hit... mark it
###
##      add_myreplaytv_show($title,$chan,$hhmm,$len,$day);
###
### not sure why we're marking this here. It prevents display when a show moves!
###
###     $ep->{device} = $device;
##      $found       .= ":$day";
##
##      } # myreplay day search
##
###
### add it as an unknown if not found
###
##      unless ($found)
##      {
##          $days="*" if $days eq "Sun, Mon, Tue, Wed, Thu, Fri, Sat";
##
##          unless (add_myreplaytv_show($title,$chan,$hhmm,$len,""))
##          {
##              print STDERR "        Can't guess day, using title scan for ",join("|",$title,$chan,$hhmm,$days),"\n";
##          }
##      }
##    } # show entry match
##} # listing loop
##
##load_show_table(); # build indexes
##} # MYREPLAY


#
# is it time to CONFIGURE?  --------------------------------------------------------
#
if ($CONFIGURE)
{
   if ($SEASON_RESET) {     # season-reset is an experiemtnal way to reset for a new season
	   for my $show (@SHOWS)
	    {
	      for my $key (keys %$show) {
		    next if $key eq 'title';
		    next if $key eq 'channel';
                    delete $show->{$key};
	        } #key loop
	    } # show loop
    load_show_table(); # build indexes
    } #SEASON-RESET

#
# create main window!
#

$TOP = MainWindow->new;
$TOP->focusmodel("active");

#
# configure menu bar
#
{
my $menubar = $TOP->Menu(-type => 'menubar');

$TOP->OnDestroy( sub{
                      return if changed_check(1);
                      $TOP -> destroy();
                    }
                );

$TOP->configure(-menu => $menubar );

my $f = $menubar->cascade(-label => '~File', -tearoff => 0);
$f->command(-label   => 'New',
            -underline => 0,
            -command => sub {
                             $SHOW_XML='';
                             @SHOWS=();
                             load_show_table();
                             });

$f->command(-label   => 'Open...',
            -underline => 0,
            -command => sub {
                            return if changed_check();
                        	my $file = $TOP->getOpenFile(-filetypes => [["XML Files",".xml"]],
                                       -title => 'Open Show File');
                            load_shows($file) if defined $file;
                            });


$f->command(-label   => 'Save',
            -underline => 0,
            -command => \&Save_shows );

$f->command(-label   => 'Save As...',
            -underline => 5,
            -command => sub {
                              my $file = $TOP->getSaveFile( -filetypes => [["XML Files",".xml"]],
	                                                            -title => 'Save show file');
                              if (defined $file)
                              {
                                 $SHOW_XML=$file;
                                 Save_shows();
                              }
                            });

$f->command(-label   => 'Listings...',
            -underline => 0,
            -command => sub {
                        	my $file = $TOP->getOpenFile(-filetypes => [["XML Files",".xml"]],
             	                                         -title => 'Open Listing File' );
                            load_guide($file) if defined ($file);
                            });


$f->command(-label   => 'Exit',
            -underline => 1,
            -command => sub {
                              return if changed_check();
                              $TOP -> destroy();
                             });

my $h = $menubar->cascade(-label => '~Help', -tearoff => 0);
$h->command(-label   => 'Help',
            -underline => 0,
            -command => \&help_popup );

$h->command(-label   => 'About',
            -underline => 0,
            -command => \&help_about );

} # menu bar

#
# create show table
#
$SHOW_TABLE = $TOP->Scrolled('TableMatrix',
                  -cols => ($#COL+1),
                  -rows => ($#SHOWS > 8 ? $#SHOWS+2 : 10 ),
                  -height   => 10,
   	              -titlerows => 1,
                  -variable => \%SHOW_DATA,
                  -roworigin =>  0,  -colorigin  => 0,
		          -colstretchmode => 'all',
                  -selecttype => 'row',
                  -sparsearray => 1,
			      -state => 'disabled',
                  -anchor => 'w',
                  -exportselection => 0,
                  );
$SHOW_TABLE->colWidth( %SHOW_WIDTH );
$SHOW_TABLE->pack(-expand => 1, -fill => 'both');
$SHOW_TABLE->bind('<1>', sub {
            my $w   = shift;
            my $Ev  = $w->XEvent;
            my $row = $w->index('@'.$Ev->x.",".$Ev->y,"row");
            my $col = $w->index('@'.$Ev->x.",".$Ev->y,"col");

            $w->selectionClear('all');
            $SHOW_ROW=0;
            $UPDATE_BUTTON -> configure ( -state => "disabled" );
            $DELETE_BUTTON -> configure ( -state => "disabled" );

            if ($row)
            {
                return unless $SHOW_DATA{"$row,$COL{title}"}; # title must exist
                $SHOW_ROW=$row;
		        $UPDATE_BUTTON -> configure ( -state => "normal" );
		        $DELETE_BUTTON -> configure ( -state => "normal" );
                $w->selectionSet("$row,0","$row,".($#COL+1));
                for $col (0..$#COL)   # load selection pane
                {
                    $COL_VALUE[$col] = $SHOW_DATA{"$row,$col"};
                }
            }
            else
            {
                $SHOW_SORT = ($SHOW_SORT == $col ? -$col : $col);
                load_show_table();
            }
}); # show table click bind

my $selframe = $TOP->Frame->pack(-side => 'bottom');
#
# Control Buttons
#
{
    my $frame=$selframe->Frame()->pack( -side => 'left' );
    $CLEAR_BUTTON =
        $frame->Button( -text    => "Clear Selection",
                       -command => sub{
                				     $SHOW_ROW=0;
                                     $SHOW_TABLE->selectionClear('all');
                				     $UPDATE_BUTTON -> configure ( -state => "disabled" );
                				     $DELETE_BUTTON -> configure ( -state => "disabled" );
                                     $COL_VALUE[$_]='' foreach (0..$#COL);
                                     load_selection_items();
                                    }) -> pack(-fill => 'x');

    $ADD_BUTTON =
    $frame->Button( -text    => "Add Selection",
                       -command => sub{
        				            $SHOW_ROW=0;
                                    $SHOW_TABLE->selectionClear('all');
        				            $UPDATE_BUTTON -> configure ( -state => "disabled" );
        				            $DELETE_BUTTON -> configure ( -state => "disabled" );
        		                    return unless $COL_VALUE[$COL{title}];
                                    my $row = $#SHOWS+1;
                                    validate_col_value();
                                    $SHOWS[$row]{$COL[$_]}=$COL_VALUE[$_] foreach (0..$#COL);
                                    load_show_table();
                                    $SHOW_CHANGED=1;
                				    $COL_VALUE[$COL{title}]='';
                                   }) -> pack(-fill => 'x');
    $UPDATE_BUTTON =
    $frame->Button( -text    => "Update Show",
                    -state   => "disabled",
                    -command => sub{
                                    return unless $SHOW_ROW;
                                    return unless $COL_VALUE[$COL{title}];
                                    validate_col_value();
                                    $SHOW_DATA[$SHOW_ROW]->{$COL[$_]}=$COL_VALUE[$_] foreach (0..$#COL);
                                    $SHOW_CHANGED=1;
                                    load_show_table();
                                    }) -> pack(-fill => 'x');

    $DELETE_BUTTON =
    $frame->Button( -text    => "Delete Show",
		    -state   => "disabled",
                    -command => sub{
                                    return unless $SHOW_ROW;
                                    $SHOW_DATA[$SHOW_ROW]{title}='';
                                    load_show_table();
                                    $SHOW_CHANGED=1;
                                    }) -> pack(-fill => 'x');

} # control buttons

#
# Selector Widgets
# Type 1 ( listbox )
#
for my $col (0..$#COL)
{
    next unless $COL_TYPE[$col] == 1;
    my $frame =$selframe->Frame()->pack( -side => 'left' );
    my $label =$frame->Label(-text => $COL[$col])->pack();
    my $entry =$frame->Entry(-textvariable => \$COL_VALUE[$col])->pack();
    my $list  =$frame->Scrolled('Listbox',
                         -setgrid    => 1,
                         -height     =>12,
                         -selectmode => 'row',
                         -exportselection => 0,
                         -scrollbars => 'w');
    $list -> {SubWidget} -> {scrolled} -> privateData('Entry') -> {Entry} = $entry;
    $list -> {SubWidget} -> {scrolled} -> privateData('Entry') -> {Col} = $col;
    $list -> pack(qw/-side left -expand yes -fill both/);
    $list -> bind('<ButtonRelease 1>' => sub  {
                                            my $w = shift;
                                            my $entry = $w->privateData('Entry') -> {Entry};
                                            my $col   = $w->privateData('Entry') -> {Col};
                            			    my $val   = $w->get('active');
#print STDERR "Storing ($val) into $col\n";
                                            $COL_VALUE[$col]=$val;
                                            load_selection_items();
                                            });
    $SELECT{$COL[$col]}= { frame => $frame,
                           label => $label,
                           entry => $entry,
                           list  => $list };
} # type 1 selectors

#
# Selector Widgets
# Type 2 ( entry )
# Note: Type 2 and Type 3 share a frame
#
my $selframe2 =$selframe->Frame()->pack( -side => 'left' );
for my $col (0..$#COL)
{
    next unless $COL_TYPE[$col] == 2;

    my $frame = $selframe2;
    my $label =$frame->Label(-text => $COL[$col])->pack();
    my $entry =$frame->Entry(-textvariable => \$COL_VALUE[$col])->pack();
    $frame->Label(-text => " ")->pack();

    $SELECT{$COL[$col]}= { frame => $frame,
                           label => $label,
                           entry => $entry,
                         };
} # type 2 selectors

#
# Selector Widgets
# Type 3 ( checkbox  )
# Note: Type 2 and Type 3 share a frame
#
for my $col (0..$#COL)
{
    next unless $COL_TYPE[$col] == 3;

    my $frame = $selframe2;
    my $check = $frame->Checkbutton( -text => $COL[$col],
                                     -variable => \$COL_VALUE[$col],
                                   ) -> pack();

    $SELECT{$COL[$col]}= { frame => $frame,
                           check => $check,
                         };
} # type 3 selectors

load_selection_items();

#
# let the games begin!
#
print STDERR "GUI running\n";
Tk::MainLoop;
} # CONFIGURE

#
# Step 3, do an actual tv check --------------------------------------------------------
#
else
{

#
# Print HTML Banner
#
if ($HTML)
{
    $R_ON     = "<span style='color:red'>";
    $G_ON     = "<span style='color:gray'>";
    $B_ON     = "<span style='color:blue'>";
    $N_ON     = "<span style='color:green'>";
    $OFF      = "</span>";
    my $now = localtime();

    # Make the output in the same encoding as the programme data.  We
    # assume this is a superset of ASCII.
    #
    print <<END
       <html>
       <head>
          <meta http-equiv="Content-Type" content="text/html; charset=$ENCODING">
          <title>TV-CHECK report</title>
       </head>
       <body>
           <h1 align=center> TV-CHECK </h1>
           <h3> $now | $SHOW_XML | $GUIDE_XML </h3>
        <pre>
END
;}


#
# Build list of midnight bintimes
#
{
   my $noon=timelocal(0,0,12,substr($TODAY_MMDD,6,2),substr($TODAY_MMDD,4,2)-1,substr($TODAY_MMDD,0,4)-1900);
   foreach (0..($DAYS-1))
   {
      my $day=$WEEKDAY[(localtime($noon))[6]];
      my $midnight=$noon - 12*3600;   # by using this midnight, DST day show times will be off from 0-2am. oh well.
      unshift @{$MIDNIGHTS{$day}},$midnight;

      printf "WARNING: DST change detected on $day\n" if ((localtime($midnight))[2] != 0);
      $noon=timelocal(0,0,12,(localtime($noon+24*3600))[3,4,5]);

   }
}

#
# Build show_time index
#
print STDERR "Computing show time index\n";
my $unique=1;
for my $show (@SHOW_DATA)
{
    $show->{channel}="" unless exists $show->{channel};
    $show->{day}=""     unless exists $show->{day};

    if (exists $MIDNIGHTS{$show->{day}})  # deal with shows on a specific day
    {
        my $time_of_day=substr($show->{hhmm},0,2)*3600+substr($show->{hhmm},2,2)*60;

        for my $midnight (@{$MIDNIGHTS{$show->{day}}})
        {
             $show->{start} = $midnight + $time_of_day;
             my @date       = localtime($show->{start});
                              $date[4]++; $date[5]+=1900;
             $show->{mmdd}  = sprintf("%04d%02d%02d",@date[5,4,3]);

             if (exists $SHOW_TIME{$show->{start}}
             and exists $SHOW_TIME{$show->{start}}{$show->{channel}.$show->{title}} ) {
                     $show->{dupe}=1; # start day,time,title matches.. mark dupe
                     $SHOW_TIME{$show->{start}}{$show->{channel}.$show->{title}.($unique++)} = {%$show};
             }
             else { $SHOW_TIME{$show->{start}}{$show->{channel}.$show->{title}} = {%$show}; }
        }
     }
     else
     {
        $show->{mmdd} = "";
        $show->{day}  = "";
        $SHOW_TIME{"Z".($unique++)}{$show->{channel}} = $show;
     }

} #build SHOW_TIME index

#
# let the games begin... process shows!
#
print STDERR "Processing shows\n\n";
for my $start (sort keys %SHOW_TIME)
{
    for my $key (sort keys %{$SHOW_TIME{$start}})
    {
        my $show = $SHOW_TIME{$start}{$key};
        my $chan = $show->{channel};
        my $ep_desc = "";
  	    next unless $show->{title};

        $CHAN{$chan}{'display-name'}[0][0]=$chan unless exists $CHAN{$chan};

#
# See what episode is on at that time
#
    if ( $show -> {mmdd} ) # this phase only gets shows with a mmdd
    {
        my $ep = find_episode($show);

#
# look for close episode matches
#
        $ep=$ep->{prev} if ($ep && $ep->{prev}
                                && !($ep->{prev}->{displayed})  # don't flag shows already hit
                                && lc(get_text($ep->{title}      )) ne lc($show->{title})
                                && lc(get_text($ep->{prev}{title})) eq lc($show->{title}));

        $ep=$ep->{next} if ($ep && $ep->{next}
                                && !($ep->{next}->{displayed})  # don't flag shows already hit
                                && lc(get_text($ep->{title}      )) ne lc($show->{title})
                                && lc(get_text($ep->{next}{title})) eq lc($show->{title}));
#
# display results
#
        if (!defined $ep)
        {
           printf "${R_ON}%-60s **** NO GUIDE DATA ****${OFF}\n",sh_summary($show);
        }
        elsif ( lc(get_text($ep->{title})) ne lc($show->{title}) )
        {
           printf "${R_ON}%-50s **** wrong show in slot ****\n",sh_summary($show);
           print " "x10,ep_summary($ep),"${OFF}\n";
        }
        else # ( guess we got what we wanted )
        {
            if (length($show->{device})
                && ! $ep->{displayed}  )# don't flag shows already hit)
            {
                push @{$RECORD{$show->{device}}},$ep;
                $ep->{device}=$show->{device};
            }

            $ep->{displayed}=$show;
            print $B_ON if $BLUENEW && !$ep->{"previously-shown"};
            print ep_summary($ep),opt_summary($show),"\n";
            print $OFF  if $BLUENEW && !$ep->{"previously-shown"};
            if ( $show->{hhmm} ne $ep->{hhmm} )
            {
                print "${R_ON}     ***** Start Time Alert ***** Expected $show->{hhmm} got $ep->{hhmm}${OFF}\n";
            }
            if ( $show->{len} && $ep->{len} && $show->{len} ne $ep->{len} )
            {
                print "${R_ON}     ***** LENGTH ALERT ***** Expected $show->{len} got $ep->{len}${OFF}\n";
            }
            $ep_desc = get_text($ep ->{"sub-title"}); # use this later
        }
    }
    else
    {
       print sh_summary($show)."\n";
    }

#
# See if the show is on at other times
#
    for my $ep ( @{$GUIDE{all}{lc($show->{title})}})
    {
        gen_episode_dates($ep)    unless $ep->{day};
        next if !$NOTRUNCATE && $ep->{mmdd} lt $TODAY_MMDD;  # ignore shows before today
        next if !$NOTRUNCATE && $ep->{mmdd} ge $WEEK_MMDD ;  # ignore shows more than a week away
        next if $ep->{displayed} eq $show;
        next if length($ep->{device}) >0 && ($ep->{device} eq $show->{device}); #skip if already recording

        gen_episode_dates($ep) unless $ep->{day};


# check channel
#
        next if ( $show->{chanonly} && $chan ne $ep->{channel} );


#
# check day
#
        next if ( $show->{dayonly}  && $show->{day} ne $ep->{day});

#
# check time
#
        next if ( $show->{timeonly} && $show->{hhmm} ne $ep->{hhmm});
        if ( $show -> {neartime})
        {
            my $delta = abs( substr($show->{hhmm},0,2) -
                             substr(  $ep->{hhmm},0,2) );
            next unless $delta < 2;
        }

#
# ok, guess we're interested in it, print it
#
#   highlight new bonus episodes in green, otherwise gray
#
        my $tmp=get_text($ep ->{"sub-title"}) || "";
        if ( $ep_desc && $tmp &&
            $ep_desc ne $tmp  &&
            !$ep->{"previously-shown"} )
        {
            print " "x5,$N_ON,ep_summary($ep,1),"$OFF\n";
        }
        else
        {
            print " "x5,$G_ON,ep_summary($ep,1),"$OFF\n";
        }

#
# special hack to for ReplayTV's "smart" record
#
        if ($show->{device} =~ /^REPLAY/i )
#
# let's try leaving out ReplayTV's "smart" record hack
# for MYREPLAY shows.  It should be caught by the MYREPLAY
# code as an episode on that day
#
#            or $show->{device} =~ /^MYREPLAY/i )
        {
          next unless length($show->{day} ); # don't record title-only scans
          next unless length($show->{hhmm}); # this should never happen
          next unless $ep->{channel} eq $show->{channel}; # Replay is channel specific

#
# check show two show slots forward + back (one slot caught by start-time search)
#
          my $hit=undef;
          my $epp=undef;

          $epp = $ep->{prev} if defined $ep;
          $epp = $ep->{prev} if defined $epp;
          $hit = $epp if lc(get_text($epp->{title})) eq lc($show->{title});
          $hit = undef if $epp->{device} eq $show->{device};

          $epp = $ep->{next} if defined $ep;
          $epp = $ep->{next} if defined $epp;
          $hit = $epp if !$hit && lc(get_text($epp->{title})) eq lc($show->{title});
          $hit = undef if $epp->{device} eq $show->{device};

          if ($hit)
          {
              $epp->{device}=$show->{device};
              push @{$RECORD{$show->{device}}},$epp;
          }
        } # replay conflict check
    } # extra episode scan

#
# if the title conains a "*" character, do a full search
#
    if ( $show->{title} =~ /\*/ )
    {
        my $key=$show->{title};
        $key =~ s/\*/.\*/g;	# replace * wildcard with .*

    	for my $ep_title ( keys %{$GUIDE{all}} )
    	{
    		next unless $ep_title =~ /^$key$/i;
    		for my $ep ( @{$GUIDE{all}{$ep_title}} )
    	    {
                next if ( $show->{chanonly} && $chan ne $ep->{channel} );
                next if ( $show->{dayonly}  && $show->{day} ne $ep->{day});
                next if ( $show->{timeonly} && $show->{hhmm} ne $ep->{hhmm});
                if ( $show -> {neartime})
                {
                    my $delta = abs( substr($show->{hhmm},0,2) -
                                     substr(  $ep->{hhmm},0,2) );
                    next unless $delta < 2;
                }

                print " "x10,ep_summary($ep)."\n";
    		}
    	}
    } # wildcard scan

  print "\n";
  } # show chan loop
} # show time loop

#
# Now check for recording conflicts
#
for my $dev_name (sort keys %RECORD)
{
    my @shows = @{$RECORD{$dev_name}};
    for my $ep1 ( 0..($#shows-1) )
    {
        my $start = $shows[$ep1] -> {start};
        my $stop  = $shows[$ep1] -> {stop};
        my $header = 0;

        for my $ep2 ( ($ep1+1)..$#shows )
        {
            next if ( $shows[$ep2]->{stop}  le $start);
            next if ( $shows[$ep2]->{start} ge $stop);
            unless ($header)
            {
                delete $shows[$ep1]{device}; # don't need device print anymore
                print "${R_ON}**** recording conflict for device $dev_name\n";
                print " "x5,ep_summary($shows[$ep1]),"\n";
                $header=1;
            }
            delete $shows[$ep2]{device}; # don't need device print anymore
            print " "x5,ep_summary($shows[$ep2]),"\n";
        } # show2 loop
        print "$OFF\n" if $header;
    } # show1 loop
} # recording device loop

#
# Now check for deleted shows
#
if (defined $MYREPLAY_LIST[0] )
{
    for my $title (sort keys %OLD_SHOW)
    {
        for my $show (@{$OLD_SHOW{$title}})
        {
            next if $show->{title} ne "";     # already used?
            $show->{title}=$title;
            printf "${R_ON}** DELETED ** %-60s ${OFF}\n",sh_summary($show);
            $show->{title}="";
        }
    }
}

if ($HTML)
{
    print "</pre></body>\n";
}

#
# If we're doing a MyReplayTV scan, save show file
#    (we can't do this earlier, due to null cleanup breaking scan)
#
Save_shows() if ($MYREPLAY_USER ne '' );

} # tv check scan

#
# That's it, have a nice day
#
print STDERR "Exiting\n";
exit 0;

#
# Support subroutines -------------------------------------------------------
#

sub opt_summary
{
    my $show=shift;
    my @options=();
    foreach (0..$#COL)
    {
        next unless $COL_TYPE[$_] == 3;
        push @options,$COL[$_] if $show->{$COL[$_]};
    }
    push @options,'*DUPE*' if exists $show->{dupe};
    return '{'.join(",",@options).'}' if @options;
    return "";
} #opt_summary

#
# ep_summary
#
# Print a one-line summary of the specified episode  ( in a subroutine to make changes easier )
#
sub ep_summary
{
    my $ep   = shift || die "ep_summary, how about a episode fella!";
    my $flag = shift || 0;

    gen_episode_dates($ep) unless $ep->{day};

#
# XMLTV format does some wierd things (IMHO) for multi-part episodes. let's deal with it
#
    my $desc = get_text($ep ->{"sub-title"}) || get_text($ep->{desc}) || "";
    my @parts;
    foreach (@{$ep->{"episode-num"}})
    {
      my $text = $_->[0];
      if ($text =~ m!Part *(\d+) *of *(\d+)!i)
      {
        push @parts, "$1/$2";
      }
      elsif ($text =~ m!(\d+)/(\d+)$!)
      {
        push @parts, ($1+1)."/$2";
      }
      else
      {
	# Ignore episode-nums that aren't understood.  FIXME do properly.
      }
    }

    my $part;
    if (not @parts)
    {
      $part = "";
    }
    else
    {
      $part = shift @parts;
      foreach (@parts)
      {
	warn "discarding part $_, doesn't match $part" if $_ ne $part;
      }
    }

    gen_episode_dates($ep) unless $ep->{day};

    return join(" ",$ep->{day},
                    mmdd_swap($ep->{mmdd}),
                   "$ep->{hhmm}/$ep->{len}",
                   get_text($CHAN{ $ep->{channel}}->{'display-name'}),
        	   ($flag ? "" : get_text( $ep->{title} ) ),
        	    "\"$desc\" $part",
        	   ($ep->{"previously-shown"} ? "(R)" : "" ),
        	   ($ep->{device} ? "[$ep->{device}] " : "" ));
} # ep_summary

#
# sh_summary
#
# Print a one-line summary of the specified show  ( in a subroutine to make changes easier )
#
sub sh_summary
{
    my $show = shift;
    my $val="";
    $val =      $show->{title}." (title-scan)" unless $show->{day};
    $val =      $show->{day}                       if $show->{day};
    $val .= " ".mmdd_swap($show->{mmdd}) if $show->{mmdd};
    $val .= " ".$show->{hhmm}            if $show->{hhmm};
    $val .= "/".$show->{len}             if $show->{len};
    $val .= " ".get_text($CHAN{$show->{channel}}->{'display-name'});
    $val .= " ".$show->{title}      if $show->{day};
    $val .= " [".$show->{device}."]" if $show->{device};
    $val .= " ".opt_summary($show);
    return $val;
} #sh_summary

#
# find_episode
#
# given a pointer to a show ( with channel/date/time info) see what's playing then.
#
# we have a ordered binary date array
# Returns undef if no episodes are found (or all are greater, see above)  This is signifies no guide info
#
sub find_episode
{
    my $show = shift || die "find_episode(show), show to match please";
    my $chan = $show->{channel};
    my $time = $show->{start};

#
# first let's search for a direct match!
#
    my $ep=$GUIDE{$chan}{$time};
    return $ep if defined $ep;

#
# now let's do a binary search
#
    my $times = $GUIDE{starts}{$chan};
    return unless defined $times; # channel not found!
    my $low  = 0;
    my $high = @$times;

    while ($low < $high )
    {

        my $mid=int(($high+$low)/2);
        last       if $mid   == $low;
        $low =$mid if $time  >= $times->[$mid];
        $high=$mid if $time  <  $times->[$mid];
    }

#
# ok we may have found our show.
#
    $ep=$GUIDE{$chan}{$times->[$low]};
    gen_episode_dates($ep)   unless $ep->{day};

#
# we have a miss if result has ended before our start time.
#
    return undef if $time > $ep->{binstart}+($ep->{len}*60);

#
# guess we have a hit
#
    return $GUIDE{$chan}{$times->[$low]};

} # find_episode

#
# get_text
#
# Given a pointer to an array of [text,lang] pairs, return the best value for our langauge
# Note, if more than one value exists for a language, only the first is returned.
#
# @LANG should point to a list of languages in order of preferences
#
sub get_text
{
   my $val = (best_name(\@LANG, $_[0]))[0];
   $val = $val->[0] if ref($val);
   return $val||"";
}

####################################################################
sub load_show_table
{

%SHOW_DATA=();
%SHOW_WIDTH=();
#
# Table headings
#
for my $col (0..$#COL)
{
    $SHOW_DATA{"0,$col"}=(abs($SHOW_SORT) == $col ? uc("_$COL[$col]_") : lc($COL[$col]));
    $SHOW_WIDTH{$col}   = length($COL[$col]);
}

#
# build sort key of table data
#
my %sort_keys=();
for my $show (@SHOWS)
{
    next unless length($show->{title}); # skip deleted records
    my $key = $show->{$COL[abs($SHOW_SORT)]} || 0;

#
# special sort... by day
#
    if ( $COL[abs($SHOW_SORT)] eq 'day' )
    {
        $key=index($WEEKDAY,$key)/3;
        $key=9 if $key < 0;
        $key=int($key);
    }
#
# special sort.. channel
#
    elsif ( $COL[abs($SHOW_SORT)] eq 'chan' )
    {
        $key=sprintf("%03d",$1) if $key =~ /^(\d+)/;
    }

#
# save value
#
        push    @{$sort_keys{lc($key)}},$show;
} # build sort keys
#
# display table data sorted by key
#
my $row=0;
my @keys=sort keys %sort_keys;
   @keys = reverse @keys if $SHOW_SORT<0;
for my $key (@keys)
{
   for my $show (@{$sort_keys{$key}})
   {
      $row++;
      $SHOW_DATA[$row]=$show;

      for my $col (0..$#COL)
      {
        my $val = $show->{$COL[$col]};
        $val="" unless defined $val;
        next unless length($val);

        $DEVICE{$val}=1 if ($COL[$col] eq 'device');  # help build device list

        $SHOW_DATA{"$row,$col"}= $val;
        $SHOW_WIDTH{$col}      = length($val) if ($SHOW_WIDTH{$col}<length($val));
      }
   }
}
$SHOW_ROW=0;

$SHOW_WIDTH{$_} += 3 foreach keys %SHOW_WIDTH;
if ($SHOW_TABLE)
{
    $SHOW_TABLE -> configure (-rows => ($#SHOWS > 8  ? $#SHOWS+2 : 10 ));
    $SHOW_TABLE -> clearCache if $SHOW_TABLE;
    $SHOW_TABLE -> selectionClear('all');
    $TOP->title("tv_check config -".( $SHOW_XML || '(untitled)' ));

    $SHOW_ROW=0;
    $UPDATE_BUTTON -> configure ( -state => "disabled" );
    $DELETE_BUTTON -> configure ( -state => "disabled" );
}

load_selection_items() if $SELECT{day}; # in case device list has changed.
} # load_show_table

#
# load selection values
#
sub load_selection_items
{

#
# load Device list
#
    $SELECT{device}{list} -> delete(0,"end");
    $SELECT{device}{list} -> insert(0,"",sort keys %DEVICE);

#
# load Day list
#
    $SELECT{day}{list} -> delete(0,"end");
    $SELECT{day}{list} -> insert(0,"",@WEEKDAY);

#
# load Channel list
#
    $SELECT{channel}{list} -> delete(0,"end");
    $SELECT{channel}{list} -> insert(0,"",@CHAN);

    my $day   = $COL_VALUE[$COL{day}    ];
    my $chan  = $COL_VALUE[$COL{channel}];
    my $title = $COL_VALUE[$COL{title}  ];

    my $match = undef;

    $day   = "" unless defined $day;
    $chan  = "" unless defined $chan;
    $title = "" unless defined $title;

    $day   =~ s/^\s+|\s+$//g;
    $chan  =~ s/^\s+|\s+$//g;
    $title =~ s/^\s+|\s+$//g;

#
# load Title list ( also fill hhmm and day if known )
#

    $SELECT{title}{list} -> delete(0,"end");
    if (length($day) && length($chan))
    {
        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{$day}{$chan}});
        $match = $GUIDE{$day}{$chan}{$title};
    }
    elsif (length($day))
    {
        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{day}{$day}} );
        $match=$GUIDE{day}{$day}{$title};
    }
    elsif (length($chan))
    {
        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{chan}{$chan}} );
        $match=$GUIDE{chan}{$chan}{$title};
    }
    else
    {
        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{all}} );
        $match=$GUIDE{title}{$title};
    }

#
# if we have a match, fill all fields
#
    if ($match)
        {
	     $COL_VALUE[$COL{day}    ] = $match->[0]->[0] || "";
	     $COL_VALUE[$COL{channel}] = $match->[0]->[1] || "";
	     $COL_VALUE[$COL{hhmm}   ] = $match->[0]->[2] || "";
	     $COL_VALUE[$COL{len}    ] = $match->[0]->[3] || "";
        }
} #load_selection_items

#
# help popup
#
sub help_popup
{
    my $help = MainWindow->new;
    $help->title("tv_check help");
    $help->Label(-wraplength => '4i' ,
                -justify    => 'left',
                -text       => "
This is a program to create/maintain a show XML file for use with tv_check.

I hope it's fairly intuitive.  One thing that can get you is the aggressive nature
of the autofill of the selection fields. The good news is the routine only kicks
off when you click a listbox.  Don't click in a listbox and you can edit the raw
data all like.

Don't forget to check out README.tv_check

Good Luck!
Robert Eden
rmeden\@cpan.org
")->pack();
} # help_popup

sub help_about
{
    my $help = MainWindow->new;
    $help->title("tv_check about");
    $help->Label(-wraplength => '4i' ,
                -justify    => 'left',
                -text       => '

tv_check $Revision: 1.77 $
(C) 2002 Robert Eden
reden@cpan.org

This program can be used/distributed on the same terms as the XMLTV distribution.

http://xmltv.sourceforge.net
')->pack;
} # help_about

#
# Error popup
#
sub error_popup
{
    my $msg = shift;

    print STDERR "\nerror: $msg\n";

    $TOP->messageBox( -icon => 'error',
                      -type => 'ok',
                     -title => 'TV-Check error',
                   -message => $msg) if $TOP;
} #error popup

#
# load show array
#
sub load_shows
{
    my $file = shift;
    unless (-e $file)
    {
        print STDERR "\nWarning: show file not found ($file)\n";
        return;
    }

    $SHOW_XML = $file;
    print STDERR "Loading xml show info ($SHOW_XML)\n";

    my $twig = new XML::Twig(TwigHandlers =>
                    { shows => sub {
                                    my ($twig, $show) =@_;
                                    push @SHOWS,$show->atts;
                                    },
                      lang  => sub {
                                    my ($twig, $lang) =@_;
                                    push @LANG,$lang->text;
                                    },
                     });
    $twig->parsefile($SHOW_XML);

    printf STDERR "Loaded  xml show file ($SHOW_XML) (%d/%d)\n",$#SHOWS+1,$#LANG+1;

#
# fix show entry
#
    for my $show (@SHOWS)
    {
#
# UTF-8 encoding seems to *BREAK* display! go figure
#
        utf8::downgrade($show->{title});

#
# ensure no null values
#
        for my $col ( keys %COL )
        {
            $show->{$col} = '' unless defined $show->{$col};
        }

#
# convert channel ID to new format if ncessary
#
       if ( ! exists $CHAN{$show->{channel}}
           && exists $CHAN_NAME{$show->{channel}} )
       {
          printf STDERR "Converting Show File Channel ID %10s to %25s\n",$show->{channel},$CHAN_NAME{$show->{channel}};
          $show->{channel}=$CHAN_NAME{$show->{channel}};
       }

#
# convert numeric date if needed.
#
#        next unless length($show->{day});
        $show->{day}=$WEEKDAY[$1] if $show->{day} =~ /^(\d+)/;


    } # fix entries

    unless (@SHOWS)
    {
        error_popup("$SHOW_XML does not appear to be a show xml file");
    }

    load_show_table();

    if ($SHOW_TABLE)
    {
        $SHOW_TABLE->pack('forget');
        $SHOW_TABLE->pack(-side => 'top', -expand => 1, -fill => 'both');
    }
    $SHOW_CHANGED=0;
} #load_show


#
# load channel guide
#
sub load_guide
{
    my $file = shift;

    unless (-e $file)
    {
        error_popup("Guide file not found ($file)");
        return;
    }


    my $st=time();
    my $c=0;
    $GUIDE_XML = $file;
    print STDERR "Loading xml guide info ($file) ";
    my $xml = XMLTV::parsefile($file);

    $ENCODING = $xml->[0];
    %CHAN     = %{$xml->[2] };
    @GUIDE    = @{$xml->[3] };
    %GUIDE    = ();
    print STDERR $#GUIDE+1," recs / ",(time()-$st)," secs\n";
    unless (@GUIDE)
    {
       error_popup("Listings file ($file) invalid or empty");
    }

    #
    # Build indexes for Episode Data
    #
    $st=time();
    $c=0;
    print STDERR "Building Episode Indexes ";
    for my $ep (@GUIDE)
    {
       print STDERR "." unless $c++ % 1000;
       my $title = lc(get_text($ep->{title}));

       my $chan  = $ep->{channel} || "" ;
       $CHAN{$chan}{'display-name'}[0][0]=$chan unless exists $CHAN{$chan};

       if (! exists $ep->{start})
       {
            warn "\n     No start time for $title\n";
            next;
       }

#
# convert XMLTV time to binary
#
       $ep->{stop}=$ep->{start} unless exists $ep->{stop};
       $ep->{binstart} = UnixDate($ep->{start},"%s");

#
# don't consider a show a repeat if it has been shown in the past 2 months.
#
       delete $ep->{"previously-shown"} if exists $ep->{"previously-shown"}
                                       and exists $ep->{"previously-shown"}{start}
                                       and $ep->{"previously-shown"}{start} gt $TWOM_MMDD;
       $ep->{displayed}="";
       $ep->{device}="";

#
# build general indexes (--scan + --configure)
#
       push @{$GUIDE{all}{$title}},$ep;                            # all titles
       $GUIDE{$chan}{$ep->{binstart}}=$ep;	                   # chan, datetime

#
# build --configure only indexes
#
       if ($CONFIGURE)
       {
          gen_episode_dates($ep);
          my $array = [$ep->{day},$ep->{channel},$ep->{hhmm},$ep->{len}];

          push @{$GUIDE{title}     {$title}}                 ,$array; # titles by chan
          push @{$GUIDE{chan}      {$chan}      {$title}}    ,$array; # titles by chan
          push @{$GUIDE{day}       {$ep->{day}} {$title}}    ,$array; # titles by day
          push @{$GUIDE{$ep->{day}}{$chan}      {$title}}    ,$array; # titles by chan by day
        }
    } # building guide indexes

#
# Now compute next/prev episodes and start time array
#
    for my $chan (keys %GUIDE)
    {
	$GUIDE{starts}{$chan}=[sort keys %{$GUIDE{$chan}}];  # start time array

        my $prev=undef;
        next if $chan eq 'chan';  # skip special indexes
        next if $chan eq 'day';
        next if $chan eq 'all';
        next if $chan eq 'starts';
        next unless exists $CHAN{$chan};

        for my $date ( @{$GUIDE{starts}{$chan}} )
        {
            my $ep=$GUIDE{$chan}{$date};
            $ep  ->{prev}=$prev;
            $prev->{next}=$ep    if defined $prev;
            $prev        =$ep;
        } #date
      $prev->{next}=undef if defined $prev;
    } #chan

    print STDERR " $c recs / ",time()-$st,"secs \n";
    error_popup("guide file $GUIDE_XML does not appear to be valid") unless @GUIDE;

    #
    # Build channel sort
    #
    my %sorting;
    foreach (keys %CHAN )
    {
        my $key = $_;
           $key=sprintf("%03d",$1) if /^(\d+)/;
        $sorting{$key}=$_;
        $CHAN_NAME{get_text($CHAN{$_}->{'display-name'})}=$_,

    }
    @CHAN=();
    map { push @CHAN,$sorting{$_}; } sort keys %sorting;


  load_selection_items() if $SELECT{day};
} #load_guide


#
# Generate XML to save current show array
#
sub Save_shows
{
    unless ($SHOW_XML)
    {
        error_popup("no show file defined, data will be lost, aborting");
        return 1;
    }

#
# recreate show array dropping deleted elements
#
    my @newshow;
    for my $show (@SHOWS)
    {
        next unless $show -> {title};
        for my $item ( keys %$show )
        {
            if ( exists $COL{$item} )
            {
                delete $show -> {$item} unless $show->{$item}; #no null values
            }
            else
            {
                delete $show -> {$item};  # no "extra" values
            }
        }
        push @newshow,$show;
    }

#
# dump xml
#
    print STDERR "saving shows to $SHOW_XML\n";
    my $output = new IO::File(">$SHOW_XML");
    my $writer = new XML::Writer(OUTPUT=>$output,
                                 DATA_MODE=>1,
                                 DATA_INDENT=>2);
    $writer->xmlDecl("ISO-8859-1");
    $writer->startTag('tv_check');
    $writer->emptyTag('lang' ,%$_) foreach (@LANG);
    $writer->emptyTag('shows',%$_) foreach (@newshow);
    $writer->endTag('tv_check');
    $writer->end;
    $SHOW_CHANGED=0;
} # Save_shows

#
# give chance to save file before losing changes
#
sub changed_check
{
    my $nocan = shift || 0;
    if ($SHOW_CHANGED)
    {
        my $button = lc($TOP->messageBox( -icon => 'warning',
                                       -type => ( $nocan ? 'YesNo' : 'YesNoCancel'),
                                       -title => 'File Change Warning',
                                       -message => "Show data changed. Do you want to save?"));
        if    ($button eq 'yes')     { Save_shows(); }
        elsif ($button eq 'cancel' ) { return 1;    }
        elsif ($button ne 'no' )     { die "Button returned unexpected value <$button>\n"};
        $SHOW_CHANGED=0; # prevent 2nd warning
    }
    return 0;
} # changed_check

#
# Note, Date::Manip doesn't deal with DST switch correctly. We need to use localtime
#
sub gen_episode_dates
{
   my $ep = shift || die "empty episode ";

   my @d=localtime($ep->{binstart}); $d[4]++; $d[5]+=1900;

   $ep->{day}  = $WEEKDAY[$d[6]];
   $ep->{hhmm} = sprintf("%02d%02d",@d[2,1]);
   $ep->{mmdd} = sprintf("%4d%02d%02d",@d[5,4,3]);
   $ep->{len}  = Delta_Format( DateCalc( $ep->{start},$ep->{stop}), 0,"%mh");

} # gen_episode_dates

#
#
#
sub validate_col_value
{
    for my $col (0..$#COL)
    {
        $_ = $COL_VALUE[$col];
        $_ = '' unless defined $_;
        next unless length($_) ;

        s/^\s+|\s+$//g;
        if ($COL[$col] eq 'len')
        {
            $_ = '' unless /^\d+/;
        }
        if ($COL_TYPE[$col] == 3)
        {
            $_ = ( $_ ? 1 : '');
        }
        $COL_VALUE[$col] = $_;
    }
} # validate_col_value

sub add_myreplaytv_show
{
    print STDERR "                   adding myreplaytv: @_\n" if ($MYREPLAY_DEBUG == 2);
    my $show;
    my $title = shift || '';
    my $chan  = shift || '';
    my $start = shift || '';
    my $len   = shift || '';
    my $day   = shift || '';
    my $foundit = 0;                 #used to supress message on auto-theme

    printf STDERR "want <%s>/<%s>/<%s>\n",$chan,$start,$day if ($MYREPLAY_DEBUG == 2);
    for my $old (@{$OLD_SHOW{$title}})   # capture settings from pre-existing show
    {
        next if $old->{title} ne "";     # already used?

        printf STDERR "    got <%s>/<%s>.<%s>\n",$old->{channel},$old->{hhmm},$old->{day} if ($MYREPLAY_DEBUG == 2);
        if (   (     $old->{channel} eq $chan     #use old show if chan/time match
                 and $old->{hhmm}    eq $start)
            || (   !$day &&                      #use old show if old and new are title only
                 ( !exists $old->{day} or $old->{day} eq ''    ))
               )
            {
         		print STDERR "Found old $title\n" if ($MYREPLAY_DEBUG == 2);
                $foundit=1;
                $show=$old;
                $show->{day}    = $day if $day; #only change day if we know what it is!
                last;
                }
    } # old show check

    unless ($show)				# build a new show entry
    {
        print STDERR "Make new $title\n" if ($MYREPLAY_DEBUG == 2);
        $show->{$_}=''        foreach (0..$#COL); # initialize to blanks
        $show->{device} ="MyReplayTV$MYREPLAY_UNIT"; # set initial values
        $show->{chanonly}=1;
        $show->{day}=$day;
    	push @SHOWS,$show;
    }

    $show->{title}  = $title;
    $show->{channel}= $chan;
    $show->{hhmm}   = $start;
    $show->{len}    = $len;
    return $foundit;
} #add_myreplaytv_show

#
# quick routine to compute minute of day from hhmm
#
sub hhmm_min
{
    my $hh=substr($_[0],0,2);
    my $mm=substr($_[0],2,2);
    return ($hh*60+$mm)
}

#
# quick routine for mmdd->ddmm for our users across the pond
#
sub mmdd_swap
{
    my $mm=substr($_[0],4,2);
    my $dd=substr($_[0],6,2);
    return $dd.$mm if $DDMM;
    return $mm.$dd;
}
xmltv-gui 0.5.69-1 / usr / bin / tv_check
