#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#
# tv_check
#
# This script searches a channel GUIDE for shows in a show list and alerts when
# a listed show is missing from it's 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 [--myreplaytv=UNIT,USERNAME,PASSWORD] --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, alerting you to unexpected
episodes or schedule changes.

=head1 OPTIONS

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

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

B<--myreplaytv=UNIT,USERNAME,PASSWORD> Specify ReplyTV options.  The UNIT value
is the ReplayTV replay unit.  The USERNAME and PASSWORD values are the ReplayTV
username and password.

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 (for use during the repeat 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.54 2004/04/23 17:52:47 rmeden Exp $ ';

use Tk;
use Tk::TableMatrix;
use XML::Twig;
use Date::Manip;
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.54 $ ' . <<END

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

usage $0 (--configure|--scan) [--myreplay=unit,user,pass,nonguarantee] [--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

   --notruncate
     don't exclude episodes more than 7 days away in extra-episode scans
     
END
  ;

#
# Define constants
#
select STDERR; $|=1;
select STDOUT; $|=1;
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 $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 $NOTRUNCATE= 0;
my $BLUENEW   = 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( "7 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;
my %OLD_SHOW;          # {old_title}=[show entryies]

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;  # updated 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}{mmdd}{hhmm}=$ep
#
# 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'     => \$myreplayargs,
	       'html'             => \$HTML,
	       'shows=s'          => \$SHOW_XML,
	       'output=s'         => \$OUTPUT_FILE,
	       'guide|listings=s' => \$GUIDE_XML,
   	       'ddmm'             => \$DDMM,
   	       'notruncate'       => \$NOTRUNCATE,
   	       'bluenew'         =>  \$BLUENEW,
	       '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";
    }

    if (defined $myreplayargs)
    {
        ($MYREPLAY_UNIT,$MYREPLAY_USER,$MYREPLAY_PASS,$MYREPLAY_NONG,$MYREPLAY_DEBUG)=split(/,/,$myreplayargs);
        $MYREPLAY_NONG=0 unless defined $MYREPLAY_NONG;
        $MYREPLAY_DEBUG=0 unless defined $MYREPLAY_DEBUG;
        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? ----------------------------------------
#
if ($MYREPLAY_USER ne '' )
{
    my $html="";
    my $device="MyReplayTV$MYREPLAY_UNIT";

    print STDERR "Fetching shows from MyReplayTV\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;
      }

#
# Check for a time match in our list of episodes.
#
      my $found="";
      for my $ep (@{$GUIDE{all}{$title}})
      {

        my $next = $ep->{next};
        my $prev = $ep->{prev};

        next if $ep->{device} eq $device; # already recording?

        gen_episode_dates($ep)   unless $ep->{day};
        gen_episode_dates($next) if $next && !$next->{day};
        gen_episode_dates($prev) if $prev && !$prev->{day};

#
#     timeslot is a hit if start time is greater than previous show's
#                      and start time and less than next show's start time.
#
    	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?

      next if (   $prev
               && $prev->{mmdd} eq $ep->{mmdd}
               && $prev->{hhmm} gt $hhmm);

      next if (   $next
               && $next->{mmdd} eq $ep->{mmdd}
               && $next->{hhmm} lt $hhmm);

      add_myreplaytv_show($title,$chan,$hhmm,$len,$day);
      $ep->{device} = $device;
      $found       .= ":$day";

      } #epiosde scan

#
# 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)
{
#
# 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'>";
    $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 show_time index
#
print STDERR "Computing show time index\n";
my $unique=1;
for my $show (@SHOW_DATA)
{
    my $start;
    
    if ($show->{day})  # phase 1 should only deal with shows with a specific day 
    {
        $show->{day} = $WEEKDAY[$show->{day}] if ($show->{day} =~ /\d/);
        if ($TODAY eq $show->{day})
        {
            $start=parse_date(sprintf("Now at %s:%s",substr($show->{hhmm},0,2),
                                                      substr($show->{hhmm},2,2)));
        }
        else
        {
           $start=parse_date(sprintf("next %s at %s:%s",$show->{day},
                                                       substr($show->{hhmm},0,2),
                                                       substr($show->{hhmm},2,2)));
        }
        ($show->{mmdd},$show->{start}) = UnixDate( $start, "%Y%m%d","%Y%m%d");
     }
     else
     {
        $start="9999".($unique++);
        $show->{mmdd} = "";
        $show->{day}  = "";
     }
    
    unless ($start)
    {
        warn "Unable to get time for $show->{title}\n";
        next;
    }

    $show->{channel}="" unless exists $show -> {channel};
    $SHOW_TIME{$start}{$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 $chan (sort keys %{$SHOW_TIME{$start}})
    {
        my $show = $SHOW_TIME{$start}{$chan};
	next unless $show->{title};
#
# See what episode is on at that time
#
    if ( $show -> {mmdd} ) # skip this phase for certain shows
    {
        my $ep = find_episode($show);

#
# look for close episode matches
#
        $ep=$ep->{prev} if ($ep && $ep->{prev}
                                && get_text($ep->{title}      ) ne $show->{title}
                                && get_text($ep->{prev}{title}) eq $show->{title});

        $ep=$ep->{next} if ($ep && $ep->{next}
                                && get_text($ep->{title}      ) ne $show->{title}
                                && get_text($ep->{next}{title}) eq $show->{title});
#
# display results
#
        if (!defined $ep)
        {
           printf "${R_ON}%-60s **** NO GUIDE DATA ****${OFF}\n",sh_summary($show);
        }
        elsif ( get_text($ep->{title}) ne $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}))
            {
                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";
            }
        }
    }
    else
    {
       print sh_summary($show)."\n";
    }

#
# See if the show is on at other times
#
    for my $ep ( @{$GUIDE{all}{$show->{title}}})
    {
        next if substr($ep->{start},0,8) lt $TODAY_MMDD; # ignore shows before today
        next if !$NOTRUNCATE && substr($ep->{start},0,8) 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
#
        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
          my $slot=0;
          my $sh_slot = 0;
          my $ep_slot = 0;
          my $sh_ep  = ""; # holds episode data at show slot

          for my $key ( sort keys %{$GUIDE{$ep->{channel}}{$ep->{mmdd}}} )
          {
  	        unless ( $key gt $show->{hhmm} )
	        {
	    	   $sh_ep   = $GUIDE{$ep->{channel}}{$ep->{mmdd}}{$key};
               $sh_slot = $slot;
	        }
            $ep_slot = $slot unless $key gt $ep->{hhmm};
            $slot++;
          }

#
# consider it a hit if our show is on at another matching time
#
          if (  $sh_ep                                       and
                get_text($sh_ep->{title}) eq $show->{title}  and
          	    abs( $ep_slot - $sh_slot ) < 2 )
          {
              $ep->{device}=$show->{device};
              push @{$RECORD{$show->{device}}},$ep;
          }
        } # 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

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[$_]};
    }
    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;
    
#
# 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.
# Scan through start times on a specified day and report the last episode not greater than our start time.
#
# 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 $mmdd = $show->{mmdd};
    my $hhmm = $show->{hhmm};

    my $ep=undef;
    for my $key ( sort keys %{$GUIDE{$chan}{$mmdd}} )
    {
        $ep=$GUIDE{$chan}{$mmdd}{$key}{prev} unless defined $ep;
        last if $key gt $hhmm;
        $ep=$GUIDE{$chan}{$mmdd}{$key};
    }


# detect a hole in the guide.
    $ep=undef if (     defined $ep
                   and exists $ep->{stop}
                   and $ep->{stop} ne $ep->{start}
                   and substr($ep->{stop},0,8) eq $mmdd
                   and substr($ep->{stop},8,4) lt $hhmm );
                   


    return $ep;
} # 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.54 $
(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+)/;

#
# remove existing MYREPLAY_UNIT entries (they will be loaded fresh later)
#
        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}='';
        }

    } # 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 = 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;
       }
       
       $ep->{stop}=$ep->{start} unless exists $ep->{stop};
       $ep->{"previously-shown"}={} if exists $ep->{date} and $ep->{date} lt $TWOM_MMDD;
 
       $ep->{start}    =~ s/://g;
       $ep->{start}    =~ s/ .+$//; # TZ sometimes breaks Date::Manip!
       $ep->{stop}     =~ s/://g;
       $ep->{stop}     =~ s/ .+$//; # TZ sometimes breaks Date::Manip!
       $ep->{displayed}="";
       $ep->{device}="";

#
# build general indexes (--scan + --configure)
#
       push @{$GUIDE{all}{$title}},$ep;                            # all titles
       if ( $ep->{start} =~ /^(\d{8})(\d{4})/ )
       {            
         $GUIDE{$chan}{$1}{$2}=$ep;                                    # index by chan, date, time
       }

#
# 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
#
    for my $chan (keys %GUIDE)
    {
        my $prev=undef;
        next if $chan eq 'chan';
        next if $chan eq 'day';
        
        for my $date ( sort keys %{$GUIDE{$chan}})
        {
            next unless $chan =~ /^\d+ /;
            next unless $date =~ /^\d\d\d\d$/;

            for my $hhmm ( sort keys %{$GUIDE{$chan}{$date}})
            {
                next unless $hhmm=~ /^\d\d\d\d$/;
                my $ep=$GUIDE{$chan}{$date}{$hhmm};

                $ep  ->{prev}=$prev;
                $prev->{next}=$ep    if defined $prev;
                $prev        =$ep;
            } #hhmm
        } #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

sub gen_episode_dates
{
   my $ep = shift;

   my $date1= parse_date($ep->{start});

   my $date2 = defined $ep->{stop} ? parse_date($ep->{stop}) : $date1;
   my ($hhmm, $day, $mmdd ) = UnixDate( $date1,"%H%M","%a","%Y%m%d");
   my $len                  = Delta_Format( DateCalc( $date1, $date2), 0,"%mh");

   $ep->{hhmm} = $hhmm;
   $ep->{day}  = $day;
   $ep->{mmdd} = $mmdd;
   $ep->{len}  = $len;

} # 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;
}