#!/usr/bin/perl -w
#
# add_time_info
#
# Quick kludge for testing output from two different grabbers.
# Sometimes one listings source will be more informative than another
# about the timing of programmes.  Whereas the old source gave two
# programmes sharing a clump from 11:00 to 12:00, the new one tells
# you that one runs from 11:00 to 11:35 and the second from 11:35 to
# 12:00.  So the new listings source gives more information, but when
# diffing the results there will be a discrepancy and seeming 'error'.
# The answer is to patch up the old results where they agree with, but
# are less detailed than, the new.
#
# Usage: reads 'less detailed' listings from stdin and 'more detailed'
# given as a filename argument, outputs fixed-up version of 'less
# detailed' to stdout.

use strict;
use XMLTV;

# Use Log::TraceMessages if installed.
BEGIN {
    eval { require Log::TraceMessages };
    if ($@) {
	*t = sub {};
	*d = sub { '' };
    }
    else {
	*t = \&Log::TraceMessages::t;
	*d = \&Log::TraceMessages::d;
    }
}

# Use 'old' to mean the listings read from stdin, 'new' for those
# given as an argument.  Just as a shorthand.
#
my $old_data = XMLTV::parsefile('-');
my $new_data = XMLTV::parsefile(shift @ARGV);

#$Log::TraceMessages::On = 1;
my %interested;
foreach (@{$old_data->[3]}) {
    next unless defined $_->{clumpidx} and $_->{clumpidx} ne '0/1';
    push @{$interested{$_->{channel}}->{$_->{start}}}, $_;
}
t '\%interested=' . d \%interested;

my (%new, %new_channels);
foreach (@{$new_data->[3]}) {
    my $ch = $_->{channel};
    push @{$new{$ch}->{$_->{start}}}, $_;
    $new_channels{$ch} = 1;
}

my %warned_ch;
foreach my $ch (keys %interested) {
    if (not $new_channels{$ch}) {
	warn "unable to process channel $ch since not included in more detailed output\n"
	  unless $warned_ch{$ch}++;
	next;
    }

    my $s = $interested{$ch};
    my $n = $new{$ch};
    t "doing channel $ch";
    t 'fixing up: ' . d $s;
    t 'based on: ' . d $n;
    START: foreach my $start (keys %$s) {
	my @to_replace = @{$s->{$start}};
	die "funny clump size at $start on $ch" if @to_replace < 2;
	t 'clump to replace: ' . d \@to_replace;
	my $r = $n->{$start};
	die "no programmes to replace with at $start on $ch"
	  if not defined $r;
	die if ref $r ne 'ARRAY';
	my @replacement = @$r;
	die "no programmes to replace with at $start on $ch"
	  if not @replacement;
	t 'replacement: ' . d \@replacement;
	my $i = 0;
      REPLACE:
	die "too many programmes to replace with" if @replacement > @to_replace;
	foreach (@replacement) {
	    my $old = $to_replace[$i];
	    t 'updating: ' . d $old;
	    t '...based on: ' . d $_;
	    foreach my $key (qw(start stop clumpidx)) {
		if (exists $_->{$key}) {
		    $old->{$key} = $_->{$key};
		}
		else {
		    delete $old->{$key};
		}
	    }
	    t 'new version: ' . d $old;
	    ++ $i;
	    t "so far replaced $i programmes";
	}
	die if $i > @to_replace;
	if ($i == @to_replace) {
	    t 'end of clump';
	    next START;
	}
	t 'still some to replace, move forward in time';
	my $prev = $replacement[-1]; die if not $prev;
	my $follow_on_start = $prev->{stop};
	die "can't find follow-on replacement: no stop time in prev ($prev->{start}, $prev->{channel})"
	  if not defined $follow_on_start;
	t "looking for programme in new listings at $follow_on_start";
	my $follow_on = $n->{$follow_on_start};
	die "can't find follow-on replacement: none at $follow_on_start on $ch"
	  if not defined $follow_on;
	@replacement = @$follow_on; die if not @replacement;
	goto REPLACE;
    }
}
XMLTV::write_data($old_data);