[xmltv-commit] CVS: xmltv/filter tv_extractinfo_en,1.39,1.40

[Ed A. <ep...@us...>]

Update of /cvsroot/xmltv/xmltv/filter
In directory usw-pr-cvs1:/tmp/cvs-serv14208

Modified Files:
	tv_extractinfo_en 
Log Message:
Found a mysterious bug and added some more error handling and trace
messages in an attempt to track it down.  Then for some reason
renaming one variable @progs to @pps made the bug go away again.


Index: tv_extractinfo_en
===================================================================
RCS file: /cvsroot/xmltv/xmltv/filter/tv_extractinfo_en,v
retrieving revision 1.39
retrieving revision 1.40
diff -C2 -d -r1.39 -r1.40
*** tv_extractinfo_en	28 Sep 2002 21:15:49 -0000	1.39
--- tv_extractinfo_en	28 Sep 2002 22:49:02 -0000	1.40
***************
*** 153,156 ****
--- 153,157 ----
  sub scrub_empty( @ );
  sub set_stop_time( $$ );
+ sub dump_pseudo_programme( $ );
  
  # --no-create-sub-titles is an undocumented switch, affecting the
***************
*** 634,638 ****
      }
  
!     t "best result found: count $best_count, first word? $best_first_word_is_time";
  
      # Heuristic.  We require at least three valid times to split - or
--- 635,644 ----
      }
  
!     if (defined $best_interp) {
! 	t "best result found: count $best_count, first word? $best_first_word_is_time";
!     }
!     else {
! 	t "couldn't find any interpretation that worked at all";
!     }
  
      # Heuristic.  We require at least three valid times to split - or
***************
*** 647,652 ****
  
      my $split = multipart_split_desc(\@words, $best_interp);
!     use vars '@progs'; local *progs = $split->[0];
!     t 'got list of pseudo-programmes: ' . d \@progs;
      my $common = $split->[1];
      use vars '@errors'; local *errors = $split->[2];
--- 653,658 ----
  
      my $split = multipart_split_desc(\@words, $best_interp);
!     use vars '@pps'; local *pps = $split->[0];
!     t 'got list of pseudo-programmes: ' . d \@pps;
      my $common = $split->[1];
      use vars '@errors'; local *errors = $split->[2];
***************
*** 664,675 ****
      # 'time' instead of real start time+date.
      #
!     foreach (@progs) {
  	my $time = delete $_->{time};
  	my $start = Date_SetTime($day, $time);
  	die if not defined $start;
  	$start = Date_ConvTZ($start, $tz, 'UTC') if defined $tz;
! 	die "subprogramme starts before main one" if Date_Cmp($start, $p->{start}) < 0;
! 	if (defined $p->{stop}) {
! 	    die "subprogramme starts after main one stops" if Date_Cmp($p->{stop}, $start) < 0;
  	}
  
--- 670,686 ----
      # 'time' instead of real start time+date.
      #
!     foreach (@pps) {
  	my $time = delete $_->{time};
  	my $start = Date_SetTime($day, $time);
  	die if not defined $start;
  	$start = Date_ConvTZ($start, $tz, 'UTC') if defined $tz;
! 	if (Date_Cmp($start, $p->{start}) < 0) {
! 	    my $dump = dump_pseudo_programme($_);
! 	    die "subprogramme ($dump) "
! 	      . "starts before main programme ($p->{start}, $p->{title}->[0]->[0])";
! 	}
! 	if (defined $p->{stop} and Date_Cmp($p->{stop}, $start) < 0) {
! 	    my $dump = dump_pseudo_programme($_);
! 	    die "subprogramme ($dump) starts after main one stops";
  	}
  
***************
*** 708,712 ****
      if (defined $p->{stop}) {
  	t "setting stop time of last subprog to stop time of main prog ($p->{stop})";
! 	set_stop_time($progs[-1], $p->{stop});
      }
      else { t 'main prog had no stop time, not adding to last subprog' }
--- 719,723 ----
      if (defined $p->{stop}) {
  	t "setting stop time of last subprog to stop time of main prog ($p->{stop})";
! 	set_stop_time($pps[-1], $p->{stop});
      }
      else { t 'main prog had no stop time, not adding to last subprog' }
***************
*** 716,720 ****
      # necessary.
      #
!     my $first_sub_start = $progs[0]->{start};
      my $cmp = Date_Cmp(pd($first_sub_start), $p_start);
      if ($cmp < 0) {
--- 727,731 ----
      # necessary.
      #
!     my $first_sub_start = $pps[0]->{start};
      my $cmp = Date_Cmp(pd($first_sub_start), $p_start);
      if ($cmp < 0) {
***************
*** 732,743 ****
  	t 'inserting dummy subprogramme: ' . d $dummy;
  	cst $dummy if $SLOW;
! 	unshift @progs, $dummy;
      }
      else { die }
  
!     if ($SLOW) { cst $_ foreach @progs }
!     scrub_empty($_->{title}, $_->{"sub-title"}, $_->{desc}) foreach @progs;
!     t 'returning new list of programmes: ' . d \@progs;
!     return \@progs;
  }
  # Given a programme description split into a list of words, and a
--- 743,754 ----
  	t 'inserting dummy subprogramme: ' . d $dummy;
  	cst $dummy if $SLOW;
! 	unshift @pps, $dummy;
      }
      else { die }
  
!     if ($SLOW) { cst $_ foreach @pps }
!     scrub_empty($_->{title}, $_->{"sub-title"}, $_->{desc}) foreach @pps;
!     t 'returning new list of programmes: ' . d \@pps;
!     return \@pps;
  }
  # Given a programme description split into a list of words, and a
***************
*** 864,868 ****
  	}
      }
!     foreach (@r) { die if not defined $_->{main_title} }
      t 'returning list of pseudo-programmes: ' . d \@r;
      t '...and common text: ' . d $common;
--- 875,882 ----
  	}
      }
!     foreach (@r) {
! 	die if not keys %$_;
! 	die if not defined $_->{main_title};
!     }
      t 'returning list of pseudo-programmes: ' . d \@r;
      t '...and common text: ' . d $common;
***************
*** 892,895 ****
--- 906,924 ----
      return [0, 0];
  }
+ # Debugging stringification.
+ sub dump_pseudo_programme( $ ) {
+     my @r;
+     my $pp = shift;
+     foreach (qw(time main_title main_desc)) {
+ 	push @r, $pp->{$_} if defined $pp->{$_};
+     }
+     if (not @r) {
+ 	local $Log::TraceMessages::On =  1;
+ 	t 'strange pseudo-programme: ' . d $pp;
+ 	die 'pseudo-programme without recognized keys';
+     }
+     return join(' ', @r);
+ }
+ 
  
  # time12to24()