1#!/usr/local/bin/perl -w
2#
3# tv_check
4#
5# This script searches a channel GUIDE for shows in a show list and alerts when
6# a listed show is missing from its time slot, or shows up at other days or times.
7#
8# The show list is a custom XML format.
9# The channel guide needs to be in XMLTV format.
10#
11# for details, see Usage below
12#
13# (C)2001 - Robert Eden, free to use under the GNU License.
14#
15#  Robert Eden - reden@cpan.org
16#
17#     See cvs logs entries for module history
18#
19#
20
21=pod
22
23=head1 NAME
24
25tv_check - Check TV guide listings
26
27=head1 SYNOPSIS
28
29tv_check --configure|--scan [other options]
30
31=head1 DESCRIPTIONS
32
33tv_check is a Perl script that reads in a file with show information
34and checks it against a TV guide listing, reporting on upcoming episodes
35and alerting you to unexpected episodes or schedule changes.
36
37=head1 OPTIONS
38
39B<--configure> Run configuration GUI.  Either this option or --scan must be
40provided.
41
42B<--season-reset> special --configure option to remove everything but the title to
43help new season setup.  The idea is to keep everything a "title-only" search
44until seasons begin. Then you update the details including record device. *expirimental*
45
46B<--scan> Scan TV listings.  Either this option or --configure must be provided.
47
48B<--myreplaytv=UNIT,USERNAME,PASSWORD> ** Feature removed ** This option used to
49auto-populate a config file based on myreplaytv.com.
50
51
52B<--shows=FILE> Specify the name of XML shows file (default: shows.xml).
53
54B<--guide=FILE>, B<--listings=FILE> Specify the name of XML guide file
55(default: guide.xml).
56
57B<--html> Generate output in HTML format.
58
59B<--bluenew> Highlights new episodes in blue (helpful back when there was an off-season)
60
61B<--output=FILE> Write to FILE rather than standard output
62
63B<--help> Provide a usage/help listing.
64
65=head1 SEE ALSO
66
67L<xmltv(5)>.
68
69=head1 AUTHOR
70
71Robert Eden; manpage by Kenneth J. Pronovici.
72
73=cut
74
75use strict;
76use XMLTV::Version '$Id: tv_check,v 1.77 2015/07/12 00:46:37 knowledgejunkie Exp $ ';
77
78use Tk;
79use Tk::TableMatrix;
80use XML::Twig;
81use Date::Manip;
82use Time::Local;
83use Data::Dumper;
84use Getopt::Long;
85## use HTTP::Cookies;
86## use HTTP::Request::Common qw(POST GET);
87## use LWP::UserAgent;
88use XMLTV qw(best_name);
89use XMLTV::Date;
90use XMLTV::Usage
91' tv_check v $Revision: 1.77 $ ' . <<END
92
93 part of the xmltv toolkit ( http://xmltv.sourceforge.net )
94
95usage $0 (--configure|--scan) [--options] [--output=file] [--html]
96where --options are:
97   --shows <file>
98     xml files with show info (default shows.xml )
99
100   --listings <file>
101     xml files with guide info (default guide.xml )
102
103   --configure
104     run configuration GUI instead of checking listings
105
106   --html
107     scan output is in HTML format
108
109   --ddmm
110     prints DDMM date instead of MMDD in reports
111
112   --days n
113     process n days (default 7)
114
115   --notruncate
116     don't exclude episodes before today in extra-episode scans
117     don't exclude episodes after '--days' days in extra-episode scans
118
119   --season-reset
120     special --configure option to remove everything but the title to
121      help new season setup.  The idea is to keep everything a "title-only" search
122      until its season begins, then add the details including recording device. *experimental*
123
124END
125  ;
126
127#
128# Define constants
129#
130select STDERR; $|=1;
131select STDOUT; $|=1;
132$ENV{TZ}='UTC' unless exists $ENV{TZ};
133my @WEEKDAY  = qw (Sun Mon Tue Wed Thu Fri Sat);
134my $WEEKDAY  = "SunMonTueWedThuFriSat   ";
135my $R_ON     = ""; # used for HTML output
136my $G_ON     = ""; # used for HTML output
137my $B_ON     = "";
138my $N_ON     = "";
139my $OFF      = "";
140#    COL_TYPE  1:List 2:Entry 3:checkbox
141my @COL       = qw(device day channel hhmm len title chanonly dayonly timeonly neartime );
142my %COL;
143   $COL{$COL[$_]}=$_ foreach (0..$#COL);  # populate $COL reverse hash
144
145my @COL_TYPE  = qw(1      1         1    2   2     1       3       3         3        3 );
146
147my $CONFIGURE= 0;
148my $HTML     = 0;
149my $DDMM     = 0;
150my $DAYS     = 7;
151my $NOTRUNCATE = 0;
152my $BLUENEW   = 0;
153my $SEASON_RESET =0;
154my $GUIDE_XML= 'guide.xml';
155my $SHOW_XML = 'shows.xml';
156my $OUTPUT_FILE = undef;
157my $TODAY      = $WEEKDAY[(localtime())[6]];
158(my $TODAY_MMDD)= UnixDate( "Now", "%Y%m%d");
159(my $WEEK_MMDD) = UnixDate( "$DAYS days later", "%Y%m%d");
160(my $TWOM_MMDD) = UnixDate( "2 months ago", "%Y%m%d");
161
162#
163# Global Vars/Databases
164#
165my @SHOWS        = (); # raw show data
166my $SHOW_TABLE   = ""; # stores pointer to SHOW_TABLE
167my @SHOW_DATA    = (); # pointer to raw by SHOW_TABLE row
168my %SHOW_DATA    = (); # data for SHOW_TABLE
169my %SHOW_WIDTH   = (); # column widths for SHOW_TABLE
170my %SHOW_TIME;         # order of shows for report
171my %OLD_SHOW;          # {old_title}=[show entryies]
172my %MIDNIGHTS    = (); # {day}[] Holds midnights for each future day of the week
173
174my @MYREPLAY_LIST = ();
175my $MYREPLAY_UNIT = "";  # parameters for MYREPLAY fetch
176my $MYREPLAY_USER = "";
177my $MYREPLAY_PASS = "";
178my $MYREPLAY_NONG = "";
179my $MYREPLAY_DEBUG = "";  # 0=ignore, 1=save to replay.html, 2=load from replay.html
180
181
182my $SHOW_CHANGED = 0;  # updd if show needs to be saved
183my $SHOW_SORT    = $COL{title};  # column to sort SHOW_TABLE
184my $SHOW_ROW     = 0;  # last selected row
185
186#
187# Episode data is comes from XMLTV, but data is added to the hash
188# for our own use.  Since we never write out the Episode XLM, this is ok.
189# The following non XMLTV fields are used
190#   {prev} = pointer to previous episode on channel
191#   {next} = pointer to next episode on channel
192#   {device} = device that will record this episode
193#   {hhmm} = start time     ( computed on demand or if $CONFIGURE)
194#   {day}  = start day      ( computed on demand or if $CONFIGURE)
195#   {mmdd} = start date     ( computed on demand or if $CONFIGURE)
196#   {len } = episode length ( computed on demand or if $CONFIGURE)
197
198
199my @GUIDE     = ();    # episode list
200my %GUIDE     = ();    # episode indexes
201#
202# Episode Indexes ( CAPS are constants )
203#
204#  $GUIDE{ALL}{title}=[ep...]
205#  $GUIDE{chan}{binstart}=$ep
206#  $GUIDE{starts}{chan}=[all-start-times];
207#
208# The following indexes are only used by configure mode
209#                                          array=[day,channel,hhmm,len]
210#  $GUIDE{TITLE}{title}     =[ [day,chan,hhmm,len]...]
211#  $GUIDE{CHAN}{chan}{title}=[ [day,chan,hhmm,len]...]
212#  $GUIDE{DAY}{day}{title}  =[ [day,chan,hhmm,len]...]
213#  $GUIDE{day}{chan}{title} =[ [day,chan,hhmm,len]...] This works since day!=chan.  I hope :)
214#
215my $ENCODING;          # character encoding for listings data
216
217my @CHAN      = ();    # channel list (sorted)
218my %CHAN      = ();    # channel list ( channel-id key )
219my %CHAN_NAME = ();    # channel list ( display-name key )
220
221my %SELECT    = ();    # array of selector widgits
222
223my %RECORD    = ();    # hash of shows to record (conflict check)
224my %DEVICE    = ();    # list of recording devices ( hash to avoid dupes )
225
226my $ADD_BUTTON;
227my $DELETE_BUTTON;
228my $UPDATE_BUTTON;
229my $CLEAR_BUTTON;
230my $TOP;
231my @LANG         = ();    # preferred languages
232
233my @COL_VALUE=();
234$COL_VALUE[$_] = "" foreach (0..$#COL);
235
236#
237# Step 1, Parse Parameters -------------------------------------------------------
238#
239# First lets check to see if someone asked for help.
240# this is easier to do here than later.
241{
242    my $scan=0;
243    my $help=0;
244    my $myreplayargs;
245    GetOptions('configure'    => \$CONFIGURE,
246	       'scan'             => \$scan,
247	       'myreplaytv=s'     => \@MYREPLAY_LIST,
248	       'html'             => \$HTML,
249	       'shows=s'          => \$SHOW_XML,
250	       'output=s'         => \$OUTPUT_FILE,
251	       'guide|listings=s' => \$GUIDE_XML,
252   	       'ddmm'             => \$DDMM,
253   	       'days=i'           => \$DAYS,
254   	       'notruncate'       => \$NOTRUNCATE,
255 	       'bluenew'          => \$BLUENEW,
256               'season-reset'     => \$SEASON_RESET,
257	       'help'             => \$help)
258      or usage();
259    usage(1) if $help;
260
261    die "Please select either --scan, --configure, or --help\n" if ($CONFIGURE+$scan != 1);
262    if (defined $OUTPUT_FILE)
263    {
264           print STDERR "Sending output to $OUTPUT_FILE\n";
265           open(STDOUT,">$OUTPUT_FILE") or die "Can't open for output $OUTPUT_FILE\n";
266    }
267
268    foreach (@MYREPLAY_LIST)
269    {
270        ($MYREPLAY_UNIT,$MYREPLAY_USER,$MYREPLAY_PASS,$MYREPLAY_NONG,$MYREPLAY_DEBUG)=split(/,/,$_);
271        die "MYREPLAY UNIT not specified\n" unless length($MYREPLAY_UNIT)>0;
272        die "MYREPLAY USER not specified\n" unless length($MYREPLAY_USER)>0;
273        die "MYREPLAY PASS not specified\n" unless length($MYREPLAY_PASS)>0;
274    }
275
276} # get params
277
278load_guide($GUIDE_XML);
279load_shows($SHOW_XML);
280
281### ----------------------------------------
282### do we need to get shows from MYREPLAYTV?
283###
284### disabled, since myreplaytv.com doesn't exist any more!
285###
286###
287##if (@MYREPLAY_LIST) {
288##    print STDERR "**WARNING** Replay has discontinued the MyReplayTV service. Ignoring -myreplay\n";
289##}
290### foreach (@MYREPLAY_LIST) {
291##if (0) {
292##    $MYREPLAY_UNIT=$MYREPLAY_USER=$MYREPLAY_PASS=$MYREPLAY_NONG=$MYREPLAY_DEBUG=undef;
293##    ($MYREPLAY_UNIT,$MYREPLAY_USER,$MYREPLAY_PASS,$MYREPLAY_NONG,$MYREPLAY_DEBUG)=split(/,/,$_);
294##    $MYREPLAY_NONG=0  unless defined $MYREPLAY_NONG;
295##    $MYREPLAY_DEBUG=0 unless defined $MYREPLAY_DEBUG;
296##
297##    my $html="";
298##    my $device="MyReplayTV$MYREPLAY_UNIT";
299##
300###
301### remove existing MYREPLAY_UNIT entries (they will be loaded fresh later)
302###
303##    for my $show (@SHOWS)
304##    {
305##         if (defined $MYREPLAY_UNIT and $show->{device} eq "MyReplayTV$MYREPLAY_UNIT")
306##        {
307##	        push @{$OLD_SHOW{$show->{title}}},$show; # quick hack to save previous options
308##            $show->{title}='';
309##        }
310##    }
311##
312##    print STDERR "Fetching shows from $device\n";
313##
314##if ($MYREPLAY_DEBUG != 2)
315##{
316###
317### create user agent
318###
319##    my $ua = LWP::UserAgent->new;
320##       $ua->cookie_jar( HTTP::Cookies->new);
321##       $ua->agent("tv_check/1.0" . $ua->agent);
322##
323###
324### login to MyReplayTV
325###
326###   print STDERR "MyReplayTV logging in\n";
327##    my $res = $ua->request(POST 'http://my.replaytv.com/servlet/Login',
328##                          [ username => $MYREPLAY_USER,
329##                            password => $MYREPLAY_PASS,
330##         		            savePassword => '',
331##                          ]);
332##
333##    unless ( $res->is_success && $res->title eq 'ReplayGuideRecordings' )
334##    {
335##       open(FILE,">error.html") && print(FILE $res -> as_string);
336##       die "MyReplayTV login error!. Debug info in 'error.html'\n";
337##    }
338##
339###
340### get MyReplayTV show info
341###
342##    sleep 5;
343###    print STDERR "MyReplayTV getting Replay Channels\n";
344##    $res = $ua->request( GET('http://my.replaytv.com/servlet/ReplayGuideRequests',
345##                              HTTP::Headers->new(
346##                                  Referer => 'http://my.replaytv.com/servlet/ReplayGuideRecordings'
347##                         )));
348##
349##    unless ($res->is_success && $res->title eq 'Replay Guide Shows')
350##    {
351##       open(FILE,">error.html") && print(FILE $res -> as_string);
352##       die "MyReplayTV show fetch error. Debug info in 'error.html'\n";
353##    }
354##
355###
356### debug save (to make things faster and not overload Replay's servers during debug)
357###
358##    if ($MYREPLAY_DEBUG == 1)
359##    {
360##        open(FILE,">replay_$MYREPLAY_UNIT.html");
361##        print FILE $res -> as_string;
362##        close FILE;
363##    }
364##    $html=$res->as_string;
365##}
366##else
367##{
368##    open(FILE,"<replay_$MYREPLAY_UNIT.html") || die "Can't open relpay_$MYREPLAY_UNIT.html";
369##    $html = join("\n",<FILE>);
370##    close FILE;
371##} # quick debug hack
372##
373###
374### Got the listings... find our shows
375###
376##foreach (split(/\n/,$html))
377##{
378##	s/\s+/ /g;
379##	next unless length($_)>5;
380##        next if /was scheduled to record/;
381##        next if /Nothing else is scheduled to record/;
382##
383##      if (my @a= / This show.+current episode.s. of (.+) occurring every \((.+)\) on Channel (\d+)\((.+)\).+ (\d+):(\d+)(\w). - (\d+):(\d+)(\w).+\. (.+) at /)
384##      {
385##
386##      $a[4]  = "0"             if ($a[4]==12 and $a[6] eq 'A');  # midnight -> 00;
387##      $a[7]  = "0"             if ($a[7]==12 and $a[9] eq 'A');  # midnight -> 00;
388##
389##      my $title = $a[0]; $title =~ s/\x92/'/g;  # fix illegal character in Replay Feed '
390##      my $days  = $a[1];
391##      my $chan  = "$a[2] $a[3]";
392##      my $hhmm  = sprintf("%02d%02d",(($a[6] eq 'P') && ($a[4] != 12) ? $a[4]+12 : $a[4]),$a[5]);
393##      my $stop  = sprintf("%02d%02d",(($a[9] eq 'P') && ($a[7] != 12) ? $a[7]+12 : $a[7]),$a[8]);
394##      my $guar  = ( $a[10] =~ /^Not/ ? 0 : 1 );
395##
396##      next unless $guar || $MYREPLAY_NONG;
397##
398##    my $len   = hhmm_min($stop) - hhmm_min($hhmm);
399##    $len += 24*60 if $len < 0;
400##
401##
402##print STDERR "\nMyReplay looking for ",join("|",$title,$chan,$hhmm,$len,$days),"\n" if ($MYREPLAY_DEBUG == 2);
403##
404###
405### convert channel ID to new format if ncessary
406###
407##       if ( ! exists $CHAN{$chan} && exists $CHAN_NAME{$chan} )
408##       {
409##          $chan=$CHAN_NAME{$chan};
410##       }
411##
412###
413### Check Channel
414###
415##      unless ( exists $CHAN{$chan})
416##      {
417##          print STDERR "MyReplayTV Channel '$chan' not in guide\n";
418##          $CHAN{$chan}{'display-name'}[0][0]=$chan;
419##      }
420##
421###
422### if Replay expects our show on a specific day, we can just add it
423###
424##      if (length($days) == 3)
425##      {
426##        add_myreplaytv_show($title,$chan,$hhmm,$len,$days);
427##        next;
428##      }
429##
430###
431### Now this gets tricky.  MyReplayTV tells us the time of a show, but not
432### the day.  We can't assume the show is available for all days listed
433### because that would cause too many false alarms in tv_check
434###
435### We can't use any day the show is on because of syndication.  A 2am
436### Daily showing of a weekly show would also cause false alarms.
437###
438### So, the solution is to find the episode 2 slots back and 2 slots forward.
439### If the MyReplay hhmm start time is between these values, record the day.
440###
441### This will cause problems around midnight.  I don't have a good solution there
442###
443### Personally, I now set all shows to record on a single day on the Replay, and
444### if you specify a single day, this check isn't done... there's you're work-around!
445###
446##      my $found="";
447##      for my $ep (@{$GUIDE{all}{lc($title)}})
448##      {
449##        gen_episode_dates($ep)    unless $ep->{day};
450##    	my $day  = $ep->{day};
451##
452##        next if $chan ne $ep->{channel};
453##        next if $days !~ /$day/;    	# episode on of myreplay's days?
454##        next if $found =~ /:$day/;      # already got this day?
455##
456###
457### get start time 2 slots back
458###
459##        my ($ep1,$ep2,$wstart,$wstop);
460##        $ep1= $ep;
461##        $ep1 =$ep1->{prev} if $ep1->{prev};
462##        gen_episode_dates($ep1) unless $ep1->{day};
463##
464##        $ep2= $ep1;
465##        $ep2 =$ep2->{prev} if $ep2->{prev};
466##        gen_episode_dates($ep2) unless $ep2->{day};
467##
468##        $wstart=$ep ->{hhmm};
469##        $wstart=$ep1->{hhmm} if $ep1->{day} eq $day;
470##        $wstart=$ep2->{hhmm} if $ep2->{day} eq $day;
471##
472##
473###
474### Now start time 2 slots forward
475###
476##        $ep1= $ep;
477##        $ep1 =$ep1->{next} if $ep1->{next};
478##        gen_episode_dates($ep1) unless $ep1->{day};
479##
480##        $ep2= $ep1;
481##        $ep2 =$ep2->{next} if $ep2->{next};
482##        gen_episode_dates($ep2) unless $ep2->{day};
483##
484##        $wstop=$ep ->{hhmm};
485##        $wstop=$ep1->{hhmm} if $ep1->{day} eq $day;
486##        $wstop=$ep2->{hhmm} if $ep2->{day} eq $day;
487##
488##
489##printf STDERR "day search: %s: %s<%s<%s\n",$title,$wstart,$hhmm,$wstop if $MYREPLAY_DEBUG > 1;
490##
491###
492### record the day if MyReplay start time is between these times
493###
494##        next if $hhmm lt $wstart;
495##        next if $hhmm gt $wstop;
496##
497###
498### guess it's a hit... mark it
499###
500##      add_myreplaytv_show($title,$chan,$hhmm,$len,$day);
501###
502### not sure why we're marking this here. It prevents display when a show moves!
503###
504###     $ep->{device} = $device;
505##      $found       .= ":$day";
506##
507##      } # myreplay day search
508##
509###
510### add it as an unknown if not found
511###
512##      unless ($found)
513##      {
514##          $days="*" if $days eq "Sun, Mon, Tue, Wed, Thu, Fri, Sat";
515##
516##          unless (add_myreplaytv_show($title,$chan,$hhmm,$len,""))
517##          {
518##              print STDERR "        Can't guess day, using title scan for ",join("|",$title,$chan,$hhmm,$days),"\n";
519##          }
520##      }
521##    } # show entry match
522##} # listing loop
523##
524##load_show_table(); # build indexes
525##} # MYREPLAY
526
527
528#
529# is it time to CONFIGURE?  --------------------------------------------------------
530#
531if ($CONFIGURE)
532{
533   if ($SEASON_RESET) {     # season-reset is an experiemtnal way to reset for a new season
534	   for my $show (@SHOWS)
535	    {
536	      for my $key (keys %$show) {
537		    next if $key eq 'title';
538		    next if $key eq 'channel';
539                    delete $show->{$key};
540	        } #key loop
541	    } # show loop
542    load_show_table(); # build indexes
543    } #SEASON-RESET
544
545#
546# create main window!
547#
548
549$TOP = MainWindow->new;
550$TOP->focusmodel("active");
551
552#
553# configure menu bar
554#
555{
556my $menubar = $TOP->Menu(-type => 'menubar');
557
558$TOP->OnDestroy( sub{
559                      return if changed_check(1);
560                      $TOP -> destroy();
561                    }
562                );
563
564$TOP->configure(-menu => $menubar );
565
566my $f = $menubar->cascade(-label => '~File', -tearoff => 0);
567$f->command(-label   => 'New',
568            -underline => 0,
569            -command => sub {
570                             $SHOW_XML='';
571                             @SHOWS=();
572                             load_show_table();
573                             });
574
575$f->command(-label   => 'Open...',
576            -underline => 0,
577            -command => sub {
578                            return if changed_check();
579                        	my $file = $TOP->getOpenFile(-filetypes => [["XML Files",".xml"]],
580                                       -title => 'Open Show File');
581                            load_shows($file) if defined $file;
582                            });
583
584
585$f->command(-label   => 'Save',
586            -underline => 0,
587            -command => \&Save_shows );
588
589$f->command(-label   => 'Save As...',
590            -underline => 5,
591            -command => sub {
592                              my $file = $TOP->getSaveFile( -filetypes => [["XML Files",".xml"]],
593	                                                            -title => 'Save show file');
594                              if (defined $file)
595                              {
596                                 $SHOW_XML=$file;
597                                 Save_shows();
598                              }
599                            });
600
601$f->command(-label   => 'Listings...',
602            -underline => 0,
603            -command => sub {
604                        	my $file = $TOP->getOpenFile(-filetypes => [["XML Files",".xml"]],
605             	                                         -title => 'Open Listing File' );
606                            load_guide($file) if defined ($file);
607                            });
608
609
610$f->command(-label   => 'Exit',
611            -underline => 1,
612            -command => sub {
613                              return if changed_check();
614                              $TOP -> destroy();
615                             });
616
617my $h = $menubar->cascade(-label => '~Help', -tearoff => 0);
618$h->command(-label   => 'Help',
619            -underline => 0,
620            -command => \&help_popup );
621
622$h->command(-label   => 'About',
623            -underline => 0,
624            -command => \&help_about );
625
626} # menu bar
627
628#
629# create show table
630#
631$SHOW_TABLE = $TOP->Scrolled('TableMatrix',
632                  -cols => ($#COL+1),
633                  -rows => ($#SHOWS > 8 ? $#SHOWS+2 : 10 ),
634                  -height   => 10,
635   	              -titlerows => 1,
636                  -variable => \%SHOW_DATA,
637                  -roworigin =>  0,  -colorigin  => 0,
638		          -colstretchmode => 'all',
639                  -selecttype => 'row',
640                  -sparsearray => 1,
641			      -state => 'disabled',
642                  -anchor => 'w',
643                  -exportselection => 0,
644                  );
645$SHOW_TABLE->colWidth( %SHOW_WIDTH );
646$SHOW_TABLE->pack(-expand => 1, -fill => 'both');
647$SHOW_TABLE->bind('<1>', sub {
648            my $w   = shift;
649            my $Ev  = $w->XEvent;
650            my $row = $w->index('@'.$Ev->x.",".$Ev->y,"row");
651            my $col = $w->index('@'.$Ev->x.",".$Ev->y,"col");
652
653            $w->selectionClear('all');
654            $SHOW_ROW=0;
655            $UPDATE_BUTTON -> configure ( -state => "disabled" );
656            $DELETE_BUTTON -> configure ( -state => "disabled" );
657
658            if ($row)
659            {
660                return unless $SHOW_DATA{"$row,$COL{title}"}; # title must exist
661                $SHOW_ROW=$row;
662		        $UPDATE_BUTTON -> configure ( -state => "normal" );
663		        $DELETE_BUTTON -> configure ( -state => "normal" );
664                $w->selectionSet("$row,0","$row,".($#COL+1));
665                for $col (0..$#COL)   # load selection pane
666                {
667                    $COL_VALUE[$col] = $SHOW_DATA{"$row,$col"};
668                }
669            }
670            else
671            {
672                $SHOW_SORT = ($SHOW_SORT == $col ? -$col : $col);
673                load_show_table();
674            }
675}); # show table click bind
676
677my $selframe = $TOP->Frame->pack(-side => 'bottom');
678#
679# Control Buttons
680#
681{
682    my $frame=$selframe->Frame()->pack( -side => 'left' );
683    $CLEAR_BUTTON =
684        $frame->Button( -text    => "Clear Selection",
685                       -command => sub{
686                				     $SHOW_ROW=0;
687                                     $SHOW_TABLE->selectionClear('all');
688                				     $UPDATE_BUTTON -> configure ( -state => "disabled" );
689                				     $DELETE_BUTTON -> configure ( -state => "disabled" );
690                                     $COL_VALUE[$_]='' foreach (0..$#COL);
691                                     load_selection_items();
692                                    }) -> pack(-fill => 'x');
693
694    $ADD_BUTTON =
695    $frame->Button( -text    => "Add Selection",
696                       -command => sub{
697        				            $SHOW_ROW=0;
698                                    $SHOW_TABLE->selectionClear('all');
699        				            $UPDATE_BUTTON -> configure ( -state => "disabled" );
700        				            $DELETE_BUTTON -> configure ( -state => "disabled" );
701        		                    return unless $COL_VALUE[$COL{title}];
702                                    my $row = $#SHOWS+1;
703                                    validate_col_value();
704                                    $SHOWS[$row]{$COL[$_]}=$COL_VALUE[$_] foreach (0..$#COL);
705                                    load_show_table();
706                                    $SHOW_CHANGED=1;
707                				    $COL_VALUE[$COL{title}]='';
708                                   }) -> pack(-fill => 'x');
709    $UPDATE_BUTTON =
710    $frame->Button( -text    => "Update Show",
711                    -state   => "disabled",
712                    -command => sub{
713                                    return unless $SHOW_ROW;
714                                    return unless $COL_VALUE[$COL{title}];
715                                    validate_col_value();
716                                    $SHOW_DATA[$SHOW_ROW]->{$COL[$_]}=$COL_VALUE[$_] foreach (0..$#COL);
717                                    $SHOW_CHANGED=1;
718                                    load_show_table();
719                                    }) -> pack(-fill => 'x');
720
721    $DELETE_BUTTON =
722    $frame->Button( -text    => "Delete Show",
723		    -state   => "disabled",
724                    -command => sub{
725                                    return unless $SHOW_ROW;
726                                    $SHOW_DATA[$SHOW_ROW]{title}='';
727                                    load_show_table();
728                                    $SHOW_CHANGED=1;
729                                    }) -> pack(-fill => 'x');
730
731} # control buttons
732
733#
734# Selector Widgets
735# Type 1 ( listbox )
736#
737for my $col (0..$#COL)
738{
739    next unless $COL_TYPE[$col] == 1;
740    my $frame =$selframe->Frame()->pack( -side => 'left' );
741    my $label =$frame->Label(-text => $COL[$col])->pack();
742    my $entry =$frame->Entry(-textvariable => \$COL_VALUE[$col])->pack();
743    my $list  =$frame->Scrolled('Listbox',
744                         -setgrid    => 1,
745                         -height     =>12,
746                         -selectmode => 'row',
747                         -exportselection => 0,
748                         -scrollbars => 'w');
749    $list -> {SubWidget} -> {scrolled} -> privateData('Entry') -> {Entry} = $entry;
750    $list -> {SubWidget} -> {scrolled} -> privateData('Entry') -> {Col} = $col;
751    $list -> pack(qw/-side left -expand yes -fill both/);
752    $list -> bind('<ButtonRelease 1>' => sub  {
753                                            my $w = shift;
754                                            my $entry = $w->privateData('Entry') -> {Entry};
755                                            my $col   = $w->privateData('Entry') -> {Col};
756                            			    my $val   = $w->get('active');
757#print STDERR "Storing ($val) into $col\n";
758                                            $COL_VALUE[$col]=$val;
759                                            load_selection_items();
760                                            });
761    $SELECT{$COL[$col]}= { frame => $frame,
762                           label => $label,
763                           entry => $entry,
764                           list  => $list };
765} # type 1 selectors
766
767#
768# Selector Widgets
769# Type 2 ( entry )
770# Note: Type 2 and Type 3 share a frame
771#
772my $selframe2 =$selframe->Frame()->pack( -side => 'left' );
773for my $col (0..$#COL)
774{
775    next unless $COL_TYPE[$col] == 2;
776
777    my $frame = $selframe2;
778    my $label =$frame->Label(-text => $COL[$col])->pack();
779    my $entry =$frame->Entry(-textvariable => \$COL_VALUE[$col])->pack();
780    $frame->Label(-text => " ")->pack();
781
782    $SELECT{$COL[$col]}= { frame => $frame,
783                           label => $label,
784                           entry => $entry,
785                         };
786} # type 2 selectors
787
788#
789# Selector Widgets
790# Type 3 ( checkbox  )
791# Note: Type 2 and Type 3 share a frame
792#
793for my $col (0..$#COL)
794{
795    next unless $COL_TYPE[$col] == 3;
796
797    my $frame = $selframe2;
798    my $check = $frame->Checkbutton( -text => $COL[$col],
799                                     -variable => \$COL_VALUE[$col],
800                                   ) -> pack();
801
802    $SELECT{$COL[$col]}= { frame => $frame,
803                           check => $check,
804                         };
805} # type 3 selectors
806
807load_selection_items();
808
809#
810# let the games begin!
811#
812print STDERR "GUI running\n";
813Tk::MainLoop;
814} # CONFIGURE
815
816#
817# Step 3, do an actual tv check --------------------------------------------------------
818#
819else
820{
821
822#
823# Print HTML Banner
824#
825if ($HTML)
826{
827    $R_ON     = "<span style='color:red'>";
828    $G_ON     = "<span style='color:gray'>";
829    $B_ON     = "<span style='color:blue'>";
830    $N_ON     = "<span style='color:green'>";
831    $OFF      = "</span>";
832    my $now = localtime();
833
834    # Make the output in the same encoding as the programme data.  We
835    # assume this is a superset of ASCII.
836    #
837    print <<END
838       <html>
839       <head>
840          <meta http-equiv="Content-Type" content="text/html; charset=$ENCODING">
841          <title>TV-CHECK report</title>
842       </head>
843       <body>
844           <h1 align=center> TV-CHECK </h1>
845           <h3> $now | $SHOW_XML | $GUIDE_XML </h3>
846        <pre>
847END
848;}
849
850
851#
852# Build list of midnight bintimes
853#
854{
855   my $noon=timelocal(0,0,12,substr($TODAY_MMDD,6,2),substr($TODAY_MMDD,4,2)-1,substr($TODAY_MMDD,0,4)-1900);
856   foreach (0..($DAYS-1))
857   {
858      my $day=$WEEKDAY[(localtime($noon))[6]];
859      my $midnight=$noon - 12*3600;   # by using this midnight, DST day show times will be off from 0-2am. oh well.
860      unshift @{$MIDNIGHTS{$day}},$midnight;
861
862      printf "WARNING: DST change detected on $day\n" if ((localtime($midnight))[2] != 0);
863      $noon=timelocal(0,0,12,(localtime($noon+24*3600))[3,4,5]);
864
865   }
866}
867
868#
869# Build show_time index
870#
871print STDERR "Computing show time index\n";
872my $unique=1;
873for my $show (@SHOW_DATA)
874{
875    $show->{channel}="" unless exists $show->{channel};
876    $show->{day}=""     unless exists $show->{day};
877
878    if (exists $MIDNIGHTS{$show->{day}})  # deal with shows on a specific day
879    {
880        my $time_of_day=substr($show->{hhmm},0,2)*3600+substr($show->{hhmm},2,2)*60;
881
882        for my $midnight (@{$MIDNIGHTS{$show->{day}}})
883        {
884             $show->{start} = $midnight + $time_of_day;
885             my @date       = localtime($show->{start});
886                              $date[4]++; $date[5]+=1900;
887             $show->{mmdd}  = sprintf("%04d%02d%02d",@date[5,4,3]);
888
889             if (exists $SHOW_TIME{$show->{start}}
890             and exists $SHOW_TIME{$show->{start}}{$show->{channel}.$show->{title}} ) {
891                     $show->{dupe}=1; # start day,time,title matches.. mark dupe
892                     $SHOW_TIME{$show->{start}}{$show->{channel}.$show->{title}.($unique++)} = {%$show};
893             }
894             else { $SHOW_TIME{$show->{start}}{$show->{channel}.$show->{title}} = {%$show}; }
895        }
896     }
897     else
898     {
899        $show->{mmdd} = "";
900        $show->{day}  = "";
901        $SHOW_TIME{"Z".($unique++)}{$show->{channel}} = $show;
902     }
903
904} #build SHOW_TIME index
905
906#
907# let the games begin... process shows!
908#
909print STDERR "Processing shows\n\n";
910for my $start (sort keys %SHOW_TIME)
911{
912    for my $key (sort keys %{$SHOW_TIME{$start}})
913    {
914        my $show = $SHOW_TIME{$start}{$key};
915        my $chan = $show->{channel};
916        my $ep_desc = "";
917  	    next unless $show->{title};
918
919        $CHAN{$chan}{'display-name'}[0][0]=$chan unless exists $CHAN{$chan};
920
921#
922# See what episode is on at that time
923#
924    if ( $show -> {mmdd} ) # this phase only gets shows with a mmdd
925    {
926        my $ep = find_episode($show);
927
928#
929# look for close episode matches
930#
931        $ep=$ep->{prev} if ($ep && $ep->{prev}
932                                && !($ep->{prev}->{displayed})  # don't flag shows already hit
933                                && lc(get_text($ep->{title}      )) ne lc($show->{title})
934                                && lc(get_text($ep->{prev}{title})) eq lc($show->{title}));
935
936        $ep=$ep->{next} if ($ep && $ep->{next}
937                                && !($ep->{next}->{displayed})  # don't flag shows already hit
938                                && lc(get_text($ep->{title}      )) ne lc($show->{title})
939                                && lc(get_text($ep->{next}{title})) eq lc($show->{title}));
940#
941# display results
942#
943        if (!defined $ep)
944        {
945           printf "${R_ON}%-60s **** NO GUIDE DATA ****${OFF}\n",sh_summary($show);
946        }
947        elsif ( lc(get_text($ep->{title})) ne lc($show->{title}) )
948        {
949           printf "${R_ON}%-50s **** wrong show in slot ****\n",sh_summary($show);
950           print " "x10,ep_summary($ep),"${OFF}\n";
951        }
952        else # ( guess we got what we wanted )
953        {
954            if (length($show->{device})
955                && ! $ep->{displayed}  )# don't flag shows already hit)
956            {
957                push @{$RECORD{$show->{device}}},$ep;
958                $ep->{device}=$show->{device};
959            }
960
961            $ep->{displayed}=$show;
962            print $B_ON if $BLUENEW && !$ep->{"previously-shown"};
963            print ep_summary($ep),opt_summary($show),"\n";
964            print $OFF  if $BLUENEW && !$ep->{"previously-shown"};
965            if ( $show->{hhmm} ne $ep->{hhmm} )
966            {
967                print "${R_ON}     ***** Start Time Alert ***** Expected $show->{hhmm} got $ep->{hhmm}${OFF}\n";
968            }
969            if ( $show->{len} && $ep->{len} && $show->{len} ne $ep->{len} )
970            {
971                print "${R_ON}     ***** LENGTH ALERT ***** Expected $show->{len} got $ep->{len}${OFF}\n";
972            }
973            $ep_desc = get_text($ep ->{"sub-title"}); # use this later
974        }
975    }
976    else
977    {
978       print sh_summary($show)."\n";
979    }
980
981#
982# See if the show is on at other times
983#
984    for my $ep ( @{$GUIDE{all}{lc($show->{title})}})
985    {
986        gen_episode_dates($ep)    unless $ep->{day};
987        next if !$NOTRUNCATE && $ep->{mmdd} lt $TODAY_MMDD;  # ignore shows before today
988        next if !$NOTRUNCATE && $ep->{mmdd} ge $WEEK_MMDD ;  # ignore shows more than a week away
989        next if $ep->{displayed} eq $show;
990        next if length($ep->{device}) >0 && ($ep->{device} eq $show->{device}); #skip if already recording
991
992        gen_episode_dates($ep) unless $ep->{day};
993
994
995# check channel
996#
997        next if ( $show->{chanonly} && $chan ne $ep->{channel} );
998
999
1000#
1001# check day
1002#
1003        next if ( $show->{dayonly}  && $show->{day} ne $ep->{day});
1004
1005#
1006# check time
1007#
1008        next if ( $show->{timeonly} && $show->{hhmm} ne $ep->{hhmm});
1009        if ( $show -> {neartime})
1010        {
1011            my $delta = abs( substr($show->{hhmm},0,2) -
1012                             substr(  $ep->{hhmm},0,2) );
1013            next unless $delta < 2;
1014        }
1015
1016#
1017# ok, guess we're interested in it, print it
1018#
1019#   highlight new bonus episodes in green, otherwise gray
1020#
1021        my $tmp=get_text($ep ->{"sub-title"}) || "";
1022        if ( $ep_desc && $tmp &&
1023            $ep_desc ne $tmp  &&
1024            !$ep->{"previously-shown"} )
1025        {
1026            print " "x5,$N_ON,ep_summary($ep,1),"$OFF\n";
1027        }
1028        else
1029        {
1030            print " "x5,$G_ON,ep_summary($ep,1),"$OFF\n";
1031        }
1032
1033#
1034# special hack to for ReplayTV's "smart" record
1035#
1036        if ($show->{device} =~ /^REPLAY/i )
1037#
1038# let's try leaving out ReplayTV's "smart" record hack
1039# for MYREPLAY shows.  It should be caught by the MYREPLAY
1040# code as an episode on that day
1041#
1042#            or $show->{device} =~ /^MYREPLAY/i )
1043        {
1044          next unless length($show->{day} ); # don't record title-only scans
1045          next unless length($show->{hhmm}); # this should never happen
1046          next unless $ep->{channel} eq $show->{channel}; # Replay is channel specific
1047
1048#
1049# check show two show slots forward + back (one slot caught by start-time search)
1050#
1051          my $hit=undef;
1052          my $epp=undef;
1053
1054          $epp = $ep->{prev} if defined $ep;
1055          $epp = $ep->{prev} if defined $epp;
1056          $hit = $epp if lc(get_text($epp->{title})) eq lc($show->{title});
1057          $hit = undef if $epp->{device} eq $show->{device};
1058
1059          $epp = $ep->{next} if defined $ep;
1060          $epp = $ep->{next} if defined $epp;
1061          $hit = $epp if !$hit && lc(get_text($epp->{title})) eq lc($show->{title});
1062          $hit = undef if $epp->{device} eq $show->{device};
1063
1064          if ($hit)
1065          {
1066              $epp->{device}=$show->{device};
1067              push @{$RECORD{$show->{device}}},$epp;
1068          }
1069        } # replay conflict check
1070    } # extra episode scan
1071
1072#
1073# if the title conains a "*" character, do a full search
1074#
1075    if ( $show->{title} =~ /\*/ )
1076    {
1077        my $key=$show->{title};
1078        $key =~ s/\*/.\*/g;	# replace * wildcard with .*
1079
1080    	for my $ep_title ( keys %{$GUIDE{all}} )
1081    	{
1082    		next unless $ep_title =~ /^$key$/i;
1083    		for my $ep ( @{$GUIDE{all}{$ep_title}} )
1084    	    {
1085                next if ( $show->{chanonly} && $chan ne $ep->{channel} );
1086                next if ( $show->{dayonly}  && $show->{day} ne $ep->{day});
1087                next if ( $show->{timeonly} && $show->{hhmm} ne $ep->{hhmm});
1088                if ( $show -> {neartime})
1089                {
1090                    my $delta = abs( substr($show->{hhmm},0,2) -
1091                                     substr(  $ep->{hhmm},0,2) );
1092                    next unless $delta < 2;
1093                }
1094
1095                print " "x10,ep_summary($ep)."\n";
1096    		}
1097    	}
1098    } # wildcard scan
1099
1100  print "\n";
1101  } # show chan loop
1102} # show time loop
1103
1104#
1105# Now check for recording conflicts
1106#
1107for my $dev_name (sort keys %RECORD)
1108{
1109    my @shows = @{$RECORD{$dev_name}};
1110    for my $ep1 ( 0..($#shows-1) )
1111    {
1112        my $start = $shows[$ep1] -> {start};
1113        my $stop  = $shows[$ep1] -> {stop};
1114        my $header = 0;
1115
1116        for my $ep2 ( ($ep1+1)..$#shows )
1117        {
1118            next if ( $shows[$ep2]->{stop}  le $start);
1119            next if ( $shows[$ep2]->{start} ge $stop);
1120            unless ($header)
1121            {
1122                delete $shows[$ep1]{device}; # don't need device print anymore
1123                print "${R_ON}**** recording conflict for device $dev_name\n";
1124                print " "x5,ep_summary($shows[$ep1]),"\n";
1125                $header=1;
1126            }
1127            delete $shows[$ep2]{device}; # don't need device print anymore
1128            print " "x5,ep_summary($shows[$ep2]),"\n";
1129        } # show2 loop
1130        print "$OFF\n" if $header;
1131    } # show1 loop
1132} # recording device loop
1133
1134#
1135# Now check for deleted shows
1136#
1137if (defined $MYREPLAY_LIST[0] )
1138{
1139    for my $title (sort keys %OLD_SHOW)
1140    {
1141        for my $show (@{$OLD_SHOW{$title}})
1142        {
1143            next if $show->{title} ne "";     # already used?
1144            $show->{title}=$title;
1145            printf "${R_ON}** DELETED ** %-60s ${OFF}\n",sh_summary($show);
1146            $show->{title}="";
1147        }
1148    }
1149}
1150
1151if ($HTML)
1152{
1153    print "</pre></body>\n";
1154}
1155
1156#
1157# If we're doing a MyReplayTV scan, save show file
1158#    (we can't do this earlier, due to null cleanup breaking scan)
1159#
1160Save_shows() if ($MYREPLAY_USER ne '' );
1161
1162} # tv check scan
1163
1164#
1165# That's it, have a nice day
1166#
1167print STDERR "Exiting\n";
1168exit 0;
1169
1170#
1171# Support subroutines -------------------------------------------------------
1172#
1173
1174sub opt_summary
1175{
1176    my $show=shift;
1177    my @options=();
1178    foreach (0..$#COL)
1179    {
1180        next unless $COL_TYPE[$_] == 3;
1181        push @options,$COL[$_] if $show->{$COL[$_]};
1182    }
1183    push @options,'*DUPE*' if exists $show->{dupe};
1184    return '{'.join(",",@options).'}' if @options;
1185    return "";
1186} #opt_summary
1187
1188#
1189# ep_summary
1190#
1191# Print a one-line summary of the specified episode  ( in a subroutine to make changes easier )
1192#
1193sub ep_summary
1194{
1195    my $ep   = shift || die "ep_summary, how about a episode fella!";
1196    my $flag = shift || 0;
1197
1198    gen_episode_dates($ep) unless $ep->{day};
1199
1200#
1201# XMLTV format does some wierd things (IMHO) for multi-part episodes. let's deal with it
1202#
1203    my $desc = get_text($ep ->{"sub-title"}) || get_text($ep->{desc}) || "";
1204    my @parts;
1205    foreach (@{$ep->{"episode-num"}})
1206    {
1207      my $text = $_->[0];
1208      if ($text =~ m!Part *(\d+) *of *(\d+)!i)
1209      {
1210        push @parts, "$1/$2";
1211      }
1212      elsif ($text =~ m!(\d+)/(\d+)$!)
1213      {
1214        push @parts, ($1+1)."/$2";
1215      }
1216      else
1217      {
1218	# Ignore episode-nums that aren't understood.  FIXME do properly.
1219      }
1220    }
1221
1222    my $part;
1223    if (not @parts)
1224    {
1225      $part = "";
1226    }
1227    else
1228    {
1229      $part = shift @parts;
1230      foreach (@parts)
1231      {
1232	warn "discarding part $_, doesn't match $part" if $_ ne $part;
1233      }
1234    }
1235
1236    gen_episode_dates($ep) unless $ep->{day};
1237
1238    return join(" ",$ep->{day},
1239                    mmdd_swap($ep->{mmdd}),
1240                   "$ep->{hhmm}/$ep->{len}",
1241                   get_text($CHAN{ $ep->{channel}}->{'display-name'}),
1242        	   ($flag ? "" : get_text( $ep->{title} ) ),
1243        	    "\"$desc\" $part",
1244        	   ($ep->{"previously-shown"} ? "(R)" : "" ),
1245        	   ($ep->{device} ? "[$ep->{device}] " : "" ));
1246} # ep_summary
1247
1248#
1249# sh_summary
1250#
1251# Print a one-line summary of the specified show  ( in a subroutine to make changes easier )
1252#
1253sub sh_summary
1254{
1255    my $show = shift;
1256    my $val="";
1257    $val =      $show->{title}." (title-scan)" unless $show->{day};
1258    $val =      $show->{day}                       if $show->{day};
1259    $val .= " ".mmdd_swap($show->{mmdd}) if $show->{mmdd};
1260    $val .= " ".$show->{hhmm}            if $show->{hhmm};
1261    $val .= "/".$show->{len}             if $show->{len};
1262    $val .= " ".get_text($CHAN{$show->{channel}}->{'display-name'});
1263    $val .= " ".$show->{title}      if $show->{day};
1264    $val .= " [".$show->{device}."]" if $show->{device};
1265    $val .= " ".opt_summary($show);
1266    return $val;
1267} #sh_summary
1268
1269#
1270# find_episode
1271#
1272# given a pointer to a show ( with channel/date/time info) see what's playing then.
1273#
1274# we have a ordered binary date array
1275# Returns undef if no episodes are found (or all are greater, see above)  This is signifies no guide info
1276#
1277sub find_episode
1278{
1279    my $show = shift || die "find_episode(show), show to match please";
1280    my $chan = $show->{channel};
1281    my $time = $show->{start};
1282
1283#
1284# first let's search for a direct match!
1285#
1286    my $ep=$GUIDE{$chan}{$time};
1287    return $ep if defined $ep;
1288
1289#
1290# now let's do a binary search
1291#
1292    my $times = $GUIDE{starts}{$chan};
1293    return unless defined $times; # channel not found!
1294    my $low  = 0;
1295    my $high = @$times;
1296
1297    while ($low < $high )
1298    {
1299
1300        my $mid=int(($high+$low)/2);
1301        last       if $mid   == $low;
1302        $low =$mid if $time  >= $times->[$mid];
1303        $high=$mid if $time  <  $times->[$mid];
1304    }
1305
1306#
1307# ok we may have found our show.
1308#
1309    $ep=$GUIDE{$chan}{$times->[$low]};
1310    gen_episode_dates($ep)   unless $ep->{day};
1311
1312#
1313# we have a miss if result has ended before our start time.
1314#
1315    return undef if $time > $ep->{binstart}+($ep->{len}*60);
1316
1317#
1318# guess we have a hit
1319#
1320    return $GUIDE{$chan}{$times->[$low]};
1321
1322} # find_episode
1323
1324#
1325# get_text
1326#
1327# Given a pointer to an array of [text,lang] pairs, return the best value for our langauge
1328# Note, if more than one value exists for a language, only the first is returned.
1329#
1330# @LANG should point to a list of languages in order of preferences
1331#
1332sub get_text
1333{
1334   my $val = (best_name(\@LANG, $_[0]))[0];
1335   $val = $val->[0] if ref($val);
1336   return $val||"";
1337}
1338
1339####################################################################
1340sub load_show_table
1341{
1342
1343%SHOW_DATA=();
1344%SHOW_WIDTH=();
1345#
1346# Table headings
1347#
1348for my $col (0..$#COL)
1349{
1350    $SHOW_DATA{"0,$col"}=(abs($SHOW_SORT) == $col ? uc("_$COL[$col]_") : lc($COL[$col]));
1351    $SHOW_WIDTH{$col}   = length($COL[$col]);
1352}
1353
1354#
1355# build sort key of table data
1356#
1357my %sort_keys=();
1358for my $show (@SHOWS)
1359{
1360    next unless length($show->{title}); # skip deleted records
1361    my $key = $show->{$COL[abs($SHOW_SORT)]} || 0;
1362
1363#
1364# special sort... by day
1365#
1366    if ( $COL[abs($SHOW_SORT)] eq 'day' )
1367    {
1368        $key=index($WEEKDAY,$key)/3;
1369        $key=9 if $key < 0;
1370        $key=int($key);
1371    }
1372#
1373# special sort.. channel
1374#
1375    elsif ( $COL[abs($SHOW_SORT)] eq 'chan' )
1376    {
1377        $key=sprintf("%03d",$1) if $key =~ /^(\d+)/;
1378    }
1379
1380#
1381# save value
1382#
1383        push    @{$sort_keys{lc($key)}},$show;
1384} # build sort keys
1385#
1386# display table data sorted by key
1387#
1388my $row=0;
1389my @keys=sort keys %sort_keys;
1390   @keys = reverse @keys if $SHOW_SORT<0;
1391for my $key (@keys)
1392{
1393   for my $show (@{$sort_keys{$key}})
1394   {
1395      $row++;
1396      $SHOW_DATA[$row]=$show;
1397
1398      for my $col (0..$#COL)
1399      {
1400        my $val = $show->{$COL[$col]};
1401        $val="" unless defined $val;
1402        next unless length($val);
1403
1404        $DEVICE{$val}=1 if ($COL[$col] eq 'device');  # help build device list
1405
1406        $SHOW_DATA{"$row,$col"}= $val;
1407        $SHOW_WIDTH{$col}      = length($val) if ($SHOW_WIDTH{$col}<length($val));
1408      }
1409   }
1410}
1411$SHOW_ROW=0;
1412
1413$SHOW_WIDTH{$_} += 3 foreach keys %SHOW_WIDTH;
1414if ($SHOW_TABLE)
1415{
1416    $SHOW_TABLE -> configure (-rows => ($#SHOWS > 8  ? $#SHOWS+2 : 10 ));
1417    $SHOW_TABLE -> clearCache if $SHOW_TABLE;
1418    $SHOW_TABLE -> selectionClear('all');
1419    $TOP->title("tv_check config -".( $SHOW_XML || '(untitled)' ));
1420
1421    $SHOW_ROW=0;
1422    $UPDATE_BUTTON -> configure ( -state => "disabled" );
1423    $DELETE_BUTTON -> configure ( -state => "disabled" );
1424}
1425
1426load_selection_items() if $SELECT{day}; # in case device list has changed.
1427} # load_show_table
1428
1429#
1430# load selection values
1431#
1432sub load_selection_items
1433{
1434
1435#
1436# load Device list
1437#
1438    $SELECT{device}{list} -> delete(0,"end");
1439    $SELECT{device}{list} -> insert(0,"",sort keys %DEVICE);
1440
1441#
1442# load Day list
1443#
1444    $SELECT{day}{list} -> delete(0,"end");
1445    $SELECT{day}{list} -> insert(0,"",@WEEKDAY);
1446
1447#
1448# load Channel list
1449#
1450    $SELECT{channel}{list} -> delete(0,"end");
1451    $SELECT{channel}{list} -> insert(0,"",@CHAN);
1452
1453    my $day   = $COL_VALUE[$COL{day}    ];
1454    my $chan  = $COL_VALUE[$COL{channel}];
1455    my $title = $COL_VALUE[$COL{title}  ];
1456
1457    my $match = undef;
1458
1459    $day   = "" unless defined $day;
1460    $chan  = "" unless defined $chan;
1461    $title = "" unless defined $title;
1462
1463    $day   =~ s/^\s+|\s+$//g;
1464    $chan  =~ s/^\s+|\s+$//g;
1465    $title =~ s/^\s+|\s+$//g;
1466
1467#
1468# load Title list ( also fill hhmm and day if known )
1469#
1470
1471    $SELECT{title}{list} -> delete(0,"end");
1472    if (length($day) && length($chan))
1473    {
1474        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{$day}{$chan}});
1475        $match = $GUIDE{$day}{$chan}{$title};
1476    }
1477    elsif (length($day))
1478    {
1479        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{day}{$day}} );
1480        $match=$GUIDE{day}{$day}{$title};
1481    }
1482    elsif (length($chan))
1483    {
1484        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{chan}{$chan}} );
1485        $match=$GUIDE{chan}{$chan}{$title};
1486    }
1487    else
1488    {
1489        $SELECT{title}{list} -> insert(0,"",sort keys %{$GUIDE{all}} );
1490        $match=$GUIDE{title}{$title};
1491    }
1492
1493#
1494# if we have a match, fill all fields
1495#
1496    if ($match)
1497        {
1498	     $COL_VALUE[$COL{day}    ] = $match->[0]->[0] || "";
1499	     $COL_VALUE[$COL{channel}] = $match->[0]->[1] || "";
1500	     $COL_VALUE[$COL{hhmm}   ] = $match->[0]->[2] || "";
1501	     $COL_VALUE[$COL{len}    ] = $match->[0]->[3] || "";
1502        }
1503} #load_selection_items
1504
1505#
1506# help popup
1507#
1508sub help_popup
1509{
1510    my $help = MainWindow->new;
1511    $help->title("tv_check help");
1512    $help->Label(-wraplength => '4i' ,
1513                -justify    => 'left',
1514                -text       => "
1515This is a program to create/maintain a show XML file for use with tv_check.
1516
1517I hope it's fairly intuitive.  One thing that can get you is the aggressive nature
1518of the autofill of the selection fields. The good news is the routine only kicks
1519off when you click a listbox.  Don't click in a listbox and you can edit the raw
1520data all like.
1521
1522Don't forget to check out README.tv_check
1523
1524Good Luck!
1525Robert Eden
1526rmeden\@cpan.org
1527")->pack();
1528} # help_popup
1529
1530sub help_about
1531{
1532    my $help = MainWindow->new;
1533    $help->title("tv_check about");
1534    $help->Label(-wraplength => '4i' ,
1535                -justify    => 'left',
1536                -text       => '
1537
1538tv_check $Revision: 1.77 $
1539(C) 2002 Robert Eden
1540reden@cpan.org
1541
1542This program can be used/distributed on the same terms as the XMLTV distribution.
1543
1544http://xmltv.sourceforge.net
1545')->pack;
1546} # help_about
1547
1548#
1549# Error popup
1550#
1551sub error_popup
1552{
1553    my $msg = shift;
1554
1555    print STDERR "\nerror: $msg\n";
1556
1557    $TOP->messageBox( -icon => 'error',
1558                      -type => 'ok',
1559                     -title => 'TV-Check error',
1560                   -message => $msg) if $TOP;
1561} #error popup
1562
1563#
1564# load show array
1565#
1566sub load_shows
1567{
1568    my $file = shift;
1569    unless (-e $file)
1570    {
1571        print STDERR "\nWarning: show file not found ($file)\n";
1572        return;
1573    }
1574
1575    $SHOW_XML = $file;
1576    print STDERR "Loading xml show info ($SHOW_XML)\n";
1577
1578    my $twig = new XML::Twig(TwigHandlers =>
1579                    { shows => sub {
1580                                    my ($twig, $show) =@_;
1581                                    push @SHOWS,$show->atts;
1582                                    },
1583                      lang  => sub {
1584                                    my ($twig, $lang) =@_;
1585                                    push @LANG,$lang->text;
1586                                    },
1587                     });
1588    $twig->parsefile($SHOW_XML);
1589
1590    printf STDERR "Loaded  xml show file ($SHOW_XML) (%d/%d)\n",$#SHOWS+1,$#LANG+1;
1591
1592#
1593# fix show entry
1594#
1595    for my $show (@SHOWS)
1596    {
1597#
1598# UTF-8 encoding seems to *BREAK* display! go figure
1599#
1600        utf8::downgrade($show->{title});
1601
1602#
1603# ensure no null values
1604#
1605        for my $col ( keys %COL )
1606        {
1607            $show->{$col} = '' unless defined $show->{$col};
1608        }
1609
1610#
1611# convert channel ID to new format if ncessary
1612#
1613       if ( ! exists $CHAN{$show->{channel}}
1614           && exists $CHAN_NAME{$show->{channel}} )
1615       {
1616          printf STDERR "Converting Show File Channel ID %10s to %25s\n",$show->{channel},$CHAN_NAME{$show->{channel}};
1617          $show->{channel}=$CHAN_NAME{$show->{channel}};
1618       }
1619
1620#
1621# convert numeric date if needed.
1622#
1623#        next unless length($show->{day});
1624        $show->{day}=$WEEKDAY[$1] if $show->{day} =~ /^(\d+)/;
1625
1626
1627    } # fix entries
1628
1629    unless (@SHOWS)
1630    {
1631        error_popup("$SHOW_XML does not appear to be a show xml file");
1632    }
1633
1634    load_show_table();
1635
1636    if ($SHOW_TABLE)
1637    {
1638        $SHOW_TABLE->pack('forget');
1639        $SHOW_TABLE->pack(-side => 'top', -expand => 1, -fill => 'both');
1640    }
1641    $SHOW_CHANGED=0;
1642} #load_show
1643
1644
1645#
1646# load channel guide
1647#
1648sub load_guide
1649{
1650    my $file = shift;
1651
1652    unless (-e $file)
1653    {
1654        error_popup("Guide file not found ($file)");
1655        return;
1656    }
1657
1658
1659    my $st=time();
1660    my $c=0;
1661    $GUIDE_XML = $file;
1662    print STDERR "Loading xml guide info ($file) ";
1663    my $xml = XMLTV::parsefile($file);
1664
1665    $ENCODING = $xml->[0];
1666    %CHAN     = %{$xml->[2] };
1667    @GUIDE    = @{$xml->[3] };
1668    %GUIDE    = ();
1669    print STDERR $#GUIDE+1," recs / ",(time()-$st)," secs\n";
1670    unless (@GUIDE)
1671    {
1672       error_popup("Listings file ($file) invalid or empty");
1673    }
1674
1675    #
1676    # Build indexes for Episode Data
1677    #
1678    $st=time();
1679    $c=0;
1680    print STDERR "Building Episode Indexes ";
1681    for my $ep (@GUIDE)
1682    {
1683       print STDERR "." unless $c++ % 1000;
1684       my $title = lc(get_text($ep->{title}));
1685
1686       my $chan  = $ep->{channel} || "" ;
1687       $CHAN{$chan}{'display-name'}[0][0]=$chan unless exists $CHAN{$chan};
1688
1689       if (! exists $ep->{start})
1690       {
1691            warn "\n     No start time for $title\n";
1692            next;
1693       }
1694
1695#
1696# convert XMLTV time to binary
1697#
1698       $ep->{stop}=$ep->{start} unless exists $ep->{stop};
1699       $ep->{binstart} = UnixDate($ep->{start},"%s");
1700
1701#
1702# don't consider a show a repeat if it has been shown in the past 2 months.
1703#
1704       delete $ep->{"previously-shown"} if exists $ep->{"previously-shown"}
1705                                       and exists $ep->{"previously-shown"}{start}
1706                                       and $ep->{"previously-shown"}{start} gt $TWOM_MMDD;
1707       $ep->{displayed}="";
1708       $ep->{device}="";
1709
1710#
1711# build general indexes (--scan + --configure)
1712#
1713       push @{$GUIDE{all}{$title}},$ep;                            # all titles
1714       $GUIDE{$chan}{$ep->{binstart}}=$ep;	                   # chan, datetime
1715
1716#
1717# build --configure only indexes
1718#
1719       if ($CONFIGURE)
1720       {
1721          gen_episode_dates($ep);
1722          my $array = [$ep->{day},$ep->{channel},$ep->{hhmm},$ep->{len}];
1723
1724          push @{$GUIDE{title}     {$title}}                 ,$array; # titles by chan
1725          push @{$GUIDE{chan}      {$chan}      {$title}}    ,$array; # titles by chan
1726          push @{$GUIDE{day}       {$ep->{day}} {$title}}    ,$array; # titles by day
1727          push @{$GUIDE{$ep->{day}}{$chan}      {$title}}    ,$array; # titles by chan by day
1728        }
1729    } # building guide indexes
1730
1731#
1732# Now compute next/prev episodes and start time array
1733#
1734    for my $chan (keys %GUIDE)
1735    {
1736	$GUIDE{starts}{$chan}=[sort keys %{$GUIDE{$chan}}];  # start time array
1737
1738        my $prev=undef;
1739        next if $chan eq 'chan';  # skip special indexes
1740        next if $chan eq 'day';
1741        next if $chan eq 'all';
1742        next if $chan eq 'starts';
1743        next unless exists $CHAN{$chan};
1744
1745        for my $date ( @{$GUIDE{starts}{$chan}} )
1746        {
1747            my $ep=$GUIDE{$chan}{$date};
1748            $ep  ->{prev}=$prev;
1749            $prev->{next}=$ep    if defined $prev;
1750            $prev        =$ep;
1751        } #date
1752      $prev->{next}=undef if defined $prev;
1753    } #chan
1754
1755    print STDERR " $c recs / ",time()-$st,"secs \n";
1756    error_popup("guide file $GUIDE_XML does not appear to be valid") unless @GUIDE;
1757
1758    #
1759    # Build channel sort
1760    #
1761    my %sorting;
1762    foreach (keys %CHAN )
1763    {
1764        my $key = $_;
1765           $key=sprintf("%03d",$1) if /^(\d+)/;
1766        $sorting{$key}=$_;
1767        $CHAN_NAME{get_text($CHAN{$_}->{'display-name'})}=$_,
1768
1769    }
1770    @CHAN=();
1771    map { push @CHAN,$sorting{$_}; } sort keys %sorting;
1772
1773
1774  load_selection_items() if $SELECT{day};
1775} #load_guide
1776
1777
1778#
1779# Generate XML to save current show array
1780#
1781sub Save_shows
1782{
1783    unless ($SHOW_XML)
1784    {
1785        error_popup("no show file defined, data will be lost, aborting");
1786        return 1;
1787    }
1788
1789#
1790# recreate show array dropping deleted elements
1791#
1792    my @newshow;
1793    for my $show (@SHOWS)
1794    {
1795        next unless $show -> {title};
1796        for my $item ( keys %$show )
1797        {
1798            if ( exists $COL{$item} )
1799            {
1800                delete $show -> {$item} unless $show->{$item}; #no null values
1801            }
1802            else
1803            {
1804                delete $show -> {$item};  # no "extra" values
1805            }
1806        }
1807        push @newshow,$show;
1808    }
1809
1810#
1811# dump xml
1812#
1813    print STDERR "saving shows to $SHOW_XML\n";
1814    my $output = new IO::File(">$SHOW_XML");
1815    my $writer = new XML::Writer(OUTPUT=>$output,
1816                                 DATA_MODE=>1,
1817                                 DATA_INDENT=>2);
1818    $writer->xmlDecl("ISO-8859-1");
1819    $writer->startTag('tv_check');
1820    $writer->emptyTag('lang' ,%$_) foreach (@LANG);
1821    $writer->emptyTag('shows',%$_) foreach (@newshow);
1822    $writer->endTag('tv_check');
1823    $writer->end;
1824    $SHOW_CHANGED=0;
1825} # Save_shows
1826
1827#
1828# give chance to save file before losing changes
1829#
1830sub changed_check
1831{
1832    my $nocan = shift || 0;
1833    if ($SHOW_CHANGED)
1834    {
1835        my $button = lc($TOP->messageBox( -icon => 'warning',
1836                                       -type => ( $nocan ? 'YesNo' : 'YesNoCancel'),
1837                                       -title => 'File Change Warning',
1838                                       -message => "Show data changed. Do you want to save?"));
1839        if    ($button eq 'yes')     { Save_shows(); }
1840        elsif ($button eq 'cancel' ) { return 1;    }
1841        elsif ($button ne 'no' )     { die "Button returned unexpected value <$button>\n"};
1842        $SHOW_CHANGED=0; # prevent 2nd warning
1843    }
1844    return 0;
1845} # changed_check
1846
1847#
1848# Note, Date::Manip doesn't deal with DST switch correctly. We need to use localtime
1849#
1850sub gen_episode_dates
1851{
1852   my $ep = shift || die "empty episode ";
1853
1854   my @d=localtime($ep->{binstart}); $d[4]++; $d[5]+=1900;
1855
1856   $ep->{day}  = $WEEKDAY[$d[6]];
1857   $ep->{hhmm} = sprintf("%02d%02d",@d[2,1]);
1858   $ep->{mmdd} = sprintf("%4d%02d%02d",@d[5,4,3]);
1859   $ep->{len}  = Delta_Format( DateCalc( $ep->{start},$ep->{stop}), 0,"%mh");
1860
1861} # gen_episode_dates
1862
1863#
1864#
1865#
1866sub validate_col_value
1867{
1868    for my $col (0..$#COL)
1869    {
1870        $_ = $COL_VALUE[$col];
1871        $_ = '' unless defined $_;
1872        next unless length($_) ;
1873
1874        s/^\s+|\s+$//g;
1875        if ($COL[$col] eq 'len')
1876        {
1877            $_ = '' unless /^\d+/;
1878        }
1879        if ($COL_TYPE[$col] == 3)
1880        {
1881            $_ = ( $_ ? 1 : '');
1882        }
1883        $COL_VALUE[$col] = $_;
1884    }
1885} # validate_col_value
1886
1887sub add_myreplaytv_show
1888{
1889    print STDERR "                   adding myreplaytv: @_\n" if ($MYREPLAY_DEBUG == 2);
1890    my $show;
1891    my $title = shift || '';
1892    my $chan  = shift || '';
1893    my $start = shift || '';
1894    my $len   = shift || '';
1895    my $day   = shift || '';
1896    my $foundit = 0;                 #used to supress message on auto-theme
1897
1898    printf STDERR "want <%s>/<%s>/<%s>\n",$chan,$start,$day if ($MYREPLAY_DEBUG == 2);
1899    for my $old (@{$OLD_SHOW{$title}})   # capture settings from pre-existing show
1900    {
1901        next if $old->{title} ne "";     # already used?
1902
1903        printf STDERR "    got <%s>/<%s>.<%s>\n",$old->{channel},$old->{hhmm},$old->{day} if ($MYREPLAY_DEBUG == 2);
1904        if (   (     $old->{channel} eq $chan     #use old show if chan/time match
1905                 and $old->{hhmm}    eq $start)
1906            || (   !$day &&                      #use old show if old and new are title only
1907                 ( !exists $old->{day} or $old->{day} eq ''    ))
1908               )
1909            {
1910         		print STDERR "Found old $title\n" if ($MYREPLAY_DEBUG == 2);
1911                $foundit=1;
1912                $show=$old;
1913                $show->{day}    = $day if $day; #only change day if we know what it is!
1914                last;
1915                }
1916    } # old show check
1917
1918    unless ($show)				# build a new show entry
1919    {
1920        print STDERR "Make new $title\n" if ($MYREPLAY_DEBUG == 2);
1921        $show->{$_}=''        foreach (0..$#COL); # initialize to blanks
1922        $show->{device} ="MyReplayTV$MYREPLAY_UNIT"; # set initial values
1923        $show->{chanonly}=1;
1924        $show->{day}=$day;
1925    	push @SHOWS,$show;
1926    }
1927
1928    $show->{title}  = $title;
1929    $show->{channel}= $chan;
1930    $show->{hhmm}   = $start;
1931    $show->{len}    = $len;
1932    return $foundit;
1933} #add_myreplaytv_show
1934
1935#
1936# quick routine to compute minute of day from hhmm
1937#
1938sub hhmm_min
1939{
1940    my $hh=substr($_[0],0,2);
1941    my $mm=substr($_[0],2,2);
1942    return ($hh*60+$mm)
1943}
1944
1945#
1946# quick routine for mmdd->ddmm for our users across the pond
1947#
1948sub mmdd_swap
1949{
1950    my $mm=substr($_[0],4,2);
1951    my $dd=substr($_[0],6,2);
1952    return $dd.$mm if $DDMM;
1953    return $mm.$dd;
1954}
1955