Guido Diepen and Ed Avis (ed@membled.com).  Originally based on

First version by Guido Diepen and Ed Avis (ed@membled.com).

tv_grab_fi by Matti Airas.

Second version by Eric Bus (eric@fambus.nl).

Originally based on tv_grab_fi by Matti Airas.

sub time_tot_str( $ );

sub time_to_str( $ );

sub time_van_str( $ );

	my $url = 'http://www.tvgids.nl/zoekprogramma.php'

    	my $url = 'http://www.tvgids.nl/zoeken/'

	  . "?station=$ch_did&interval=$i";

    	  . "?station=$ch_did&genre=&interval=$i&timeslot=0";

	my $day = UnixDate(DateCalc($now, "+ $i days"), '%Y-%m-%d');

     	my $day = UnixDate(DateCalc($now, "+ $i days"), '%Y-%m-%d');

	die if not defined $day;

    	die if not defined $day;

	die if ref $url;

    	die if ref $url;

	push @to_get, [ $url, $day, $ch_xid, $ch_did ];

    	push @to_get, [ $url, $day, $ch_xid, $ch_did ];

	my ($start, $stop, $title, $url) = @$_;

    	my ($start, $stop, $title, $url) = @$_;

	die if ref $url;

    	die if ref $url;

	local $SIG{__WARN__} = sub { warn "$url: $_[0]" };

    	local $SIG{__WARN__} = sub { warn "$url: $_[0]" };

	for ($detail_url_to_summary_url{$url}) {

    	for ($detail_url_to_summary_url{$url}) {

	    warn "more than one programme with same details page $url"

    	    warn "more than one programme with same details page $url"

	      if defined;

    	      if defined;

	    $_ = $summary_url;

    	    $_ = $summary_url;

	}

    	}

	# Start and stop are common to a whole clump, but these

    	# Start and stop are common to a whole clump, but these

	# two are given individually for each programme.

    	# two are given individually for each programme.

	#

    	#

	my $details = [ $title, $url ];

    	my $details = [ $title, $url ];

	if (not defined $start) {

    	if (not defined $start) {

	    if (not $clump) {

    	    if (not $clump) {

		warn "programme '$title' at beginning of page has no start time, dropping\n";

        		warn "programme '$title' at beginning of page has no start time, dropping\n";

		next;

    	    	next;

	    }

    	    }

	    t 'found programme with no start time';

    	    t 'found programme with no start time';

	    if (defined $clump->[1]) {

    	    if (defined $clump->[1]) {

		t 'make it start at stop of last clump';

        		t 'make it start at stop of last clump';

		die if not defined $clump->[0];

        		die if not defined $clump->[0];

		push @clumps, $clump;

        		push @clumps, $clump;

		$clump = [ $clump->[1], $stop, [ $details ] ];

        		$clump = [ $clump->[1], $stop, [ $details ] ];

		die if not defined $clump->[0];

        		die if not defined $clump->[0];

	    }

    	    }

	    else {

    	    else {

		t 'current clump has no stop, add to clump';

        		t 'current clump has no stop, add to clump';

		push @{$clump->[2]}, $details;

        		push @{$clump->[2]}, $details;

		t 'maybe set stop of current clump';

        		t 'maybe set stop of current clump';

		$clump->[1] = $stop;

        		$clump->[1] = $stop;

	    }

    	    }

	}

    	}

	else {

    	else {

	    t 'programme has start time, make new clump';

    	    t 'programme has start time, make new clump';

	    if ($clump) {

    	    if ($clump) {

		die if not defined $clump->[0];

        		die if not defined $clump->[0];

		my $cmp = Date_Cmp($clump->[0], $start);

        		my $cmp = Date_Cmp($clump->[0], $start);

		if ($cmp == 0) {

		    # Oddity in the web pages: this programme has the

        		if ($cmp == 0) {

		    # same start time as a previous one.  (Until I

        		    # Oddity in the web pages: this programme has the

		    # found this case, the clumping was only for cases

        		    # same start time as a previous one.  (Until I

		    # where a programme lacked a start time, I think.)

        		    # found this case, the clumping was only for cases

		    # Anyway handle this by making it join the

        		    # where a programme lacked a start time, I think.)

		    # existing clump.

        		    # Anyway handle this by making it join the

		    #

        		    # existing clump.

		    t 'same start time as existing clump, join it';

        		    #

        		    t 'same start time as existing clump, join it';

		    if (defined $stop) {

			# Compare stop time of the current clump with

        		    if (defined $stop) {

			# this programme and extend the clump if

            			# Compare stop time of the current clump with

			# necessary.

            			# this programme and extend the clump if

			#

            			# necessary.

			my $cmp = Date_Cmp($clump->[1], $stop);

            			#

			if ($cmp < 0) {

            			my $cmp = Date_Cmp($clump->[1], $stop);

			    # Okay, later stop time, extend clump.

            			if ($cmp < 0) {

			    $clump->[1] = $stop;

            			    # Okay, later stop time, extend clump.

			}

            			    $clump->[1] = $stop;

			elsif ($cmp == 0) {

            			}

			    # Okay.

            			elsif ($cmp == 0) {

			}

            			    # Okay.

			elsif ($cmp > 0) {

            			}

			    warn "programme (from $start to $stop) has same start as one before it, but earlier stop, ignoring stop time\n";

            			elsif ($cmp > 0) {

			}

    	    	    	    warn "programme (from $start to $stop) has same start as one before it, but earlier stop, ignoring stop time\n";

			else { die }

        	    		}

		    }

            			else { die }

        		    }

		    push @{$clump->[2]}, $details;

		}

        		    push @{$clump->[2]}, $details;

		else {

        		}

		    # (Don't bother checking that $cmp < 0, it should

        		else {

		    # be, but often programmes appear out of order...)

        		    # (Don't bother checking that $cmp < 0, it should

		    #

    	    	    # be, but often programmes appear out of order...)

		    push @clumps, $clump;

        		    #

		    $clump = [ $start, $stop, [ $details ] ];

        		    push @clumps, $clump;

		    t 'started a new clump for new start time, now: ' . d $clump;

        		    $clump = [ $start, $stop, [ $details ] ];

		}

        		    t 'started a new clump for new start time, now: ' . d $clump;

	    }

        		}

	    else {

    	    }

		t 'no existing clump, starting one for this programme';

    	    else {

		$clump = [ $start, $stop, [ $details ] ];

        		t 'no existing clump, starting one for this programme';

	    }

        		$clump = [ $start, $stop, [ $details ] ];

	    die if not defined $clump->[0];

    	    }

	}

            die if not defined $clump->[0];

        }

	die if not defined $clump->[0];

    	die if not defined $clump->[0];

	push @clumps, $clump;

    	push @clumps, $clump;

    # Now add the clumpidx attributes.

   # Now add the clumpidx attributes.

    foreach (@clumps) {

   foreach (@clumps) {

	my ($start, $stop, $l) = @$_;

    	my ($start, $stop, $l) = @$_;

	die if not defined $start;

    	die if not defined $start;

	my $num_in_clump = @$l;

    	my $num_in_clump = @$l;

	if ($num_in_clump == 1) {

    	if ($num_in_clump == 1) {

	    # Common case, no clumpidx needed.

    	    # Common case, no clumpidx needed.

	}

    	}

	elsif ($num_in_clump > 1) {

    	elsif ($num_in_clump > 1) {

	    foreach my $i (0 .. $num_in_clump - 1) {

    	    foreach my $i (0 .. $num_in_clump - 1) {

		# Add clumpidx as last thing in list.

        		# Add clumpidx as last thing in list.

		push @{$l->[$i]}, "$i/$num_in_clump";

        		push @{$l->[$i]}, "$i/$num_in_clump";

	    }

    	    }

	}

    	}

	else { die }

    	else { die }

	my ($start, $stop, $l) = @$_;

    	my ($start, $stop, $l) = @$_;

	die if not defined $start;

    	die if not defined $start;

	foreach (@$l) {

    	foreach (@$l) {

	    my ($title, $url, $clumpidx) = @$_;

    	    my ($title, $url, $clumpidx) = @$_;

	    my %h = (channel => $ch_xmltv_id,

    	    my %h = (channel => $ch_xmltv_id,

		     title => [ [ $title, $LANG ] ],

    		     title => [ [ $title, $LANG ] ],

		    );

        );

	    for (date_to_local($start, $TZ)) {

		$h{start} = UnixDate($_->[0], '%q') . " $_->[1]";

        for (date_to_local($start, $TZ)) {

    		$h{start} = UnixDate($_->[0], '%q') . " $_->[1]";

		for (date_to_local($stop, $TZ)) {

    		for (date_to_local($stop, $TZ)) {

		    $h{stop} = UnixDate($_->[0], '%q') . " $_->[1]";

    		    $h{stop} = UnixDate($_->[0], '%q') . " $_->[1]";

		}

    		}

		die if ref $url;

    		die if ref $url;

		$h{url} = [ $url ];

    		$h{url} = [ $url ];

	    $h{clumpidx} = $clumpidx if defined $clumpidx;

	    push @summary_programmes, \%h;

        $h{clumpidx} = $clumpidx if defined $clumpidx;

        push @summary_programmes, \%h;

		# We know how to merge this.  TODO write general

    		# We know how to merge this.  TODO write general

		# XMLTV::Merge. 

    		# XMLTV::Merge. 

		#

    		#

		my %already;

    		my %already;

		foreach my $a (@$new) {

    		foreach my $a (@$new) {

		    my $d = Dumper($a);

    		    my $d = Dumper($a);

		    $already{$d}++ && warn "duplicate $_: $d";

    		    $already{$d}++ && warn "duplicate $_: $d";

		}

    		}

		foreach my $o (@$old) {

    		foreach my $o (@$old) {

		    my $d = Dumper($o);

    		    my $d = Dumper($o);

		    push @$new, $o unless $already{$d};

    		    push @$new, $o unless $already{$d};

		}

    		}

		# Compare the two data structures.  For this to work

    		# Compare the two data structures.  For this to work

		# correctly it requires Data::Dumper 2.12 or later, as

    		# correctly it requires Data::Dumper 2.12 or later, as

		# shipped with perl 5.8.0.  Older versions don't

    		# shipped with perl 5.8.0.  Older versions don't

		# support $Sortkeys.  But we don't have any version

    		# support $Sortkeys.  But we don't have any version

		# check here - in the worst case all that results from

    		# check here - in the worst case all that results from

		# using an older Data::Dumper is a few spurious

    		# using an older Data::Dumper is a few spurious

		# warning messages.

    		# warning messages.

		#

    		#

		my $old_dump = Dumper($old);

    		my $old_dump = Dumper($old);

		my $new_dump = Dumper($new);

    		my $new_dump = Dumper($new);

		if ($old_dump ne $new_dump) {

    		if ($old_dump ne $new_dump) {

		    warn "mismatch between summary page and details page $url for $_: $old_dump vs $new_dump\n";

    		    warn "mismatch between summary page and details page $url for $_: $old_dump vs $new_dump\n";

		}

    		}

	tr/\221\222/''/;

    	tr/\221\222/''/;

	if (tr/\012\015\040-\176\240-\377//dc) {

    	if (tr/\012\015\040-\176\240-\377//dc) {

	    warn 'removing bad characters' unless $warned_bad_chars++;

    	    warn 'removing bad characters' unless $warned_bad_chars++;

	}

    	}

	return $_;

    	return $_;

	warn "$url (from $master_url): $_[0]";

    	warn "$url (from $master_url): $_[0]";

	$t->parse(tidy(get_nice($url)));

    	$t->parse(tidy(get_nice($url)));

	warn "error getting/parsing $url: $@";

    	warn "error getting/parsing $url: $@";

	return;

    	return;

    my @elems = $t->look_down(class => 'detailDeel');

    if (not @elems) {

    my @elems = $t->look_down('id' => 'progDetail');

	warn "did not see any 'detailDeel' elements, skipping page";

    if (not @elems or @elems != 1) {

	return;

    	warn "did not see one single 'progDetail' element, skipping page";

    	return;

    foreach (@elems) {

    $elem = $elems[0];

	my @cont = grep { ref } $_->content_list();

    my @trs = $elem->look_down('_tag' => 'tr');

	my $n = scalar @cont;

    if( not @trs ) {

	if ($n != 2) {

        warn "did not find records below the 'data' element, skipping page";

	    warn "'detailDeel' has $n elements instead of 2";

        return;

	    next;

    }

	}

	my ($k, $v) = @cont;

    foreach (@trs) {

	for ($k->attr('class')) {

        my $tr = $_;

	    if (not defined or $_ ne 'detailLabel2') {

        my @ths = $tr->look_down('_tag' => 'th');

		warn "didn't see 'detailLabel2' in 'detailDeel'";

        my @tds = $tr->look_down('_tag' => 'td');

		next;

        if( @ths == 1 && @tds == 1 ) {

	    }

        	push @info, [ $ths[0]->as_text(), $tds[0]->as_text() ];

	}

        }

	for ($v->attr('class')) {

	    if (not defined or $_ ne 'detailContent2') {

		warn "didn't see 'detailContent2' in 'detailDeel'";

		next;

	    }

	}

	push @info, [ $k->as_text(), $v->as_text() ];

	# Exactly one:

    	# Exactly one:

	$van, $tot, $naam,

    	$van, $tot,

	# At most one:

    	# At most one:

	# Zero or more:

    	# Zero or more:

       );

    );

	if ($regel eq 'Tijdstip') {

    ELEM: foreach (@info) {

	    warn "seen 'Tijdstip' twice\n" if $seen_tijdstip++;

        my ($regel, $text) = @$_;

	    if (length($text)<=16) {

        foreach ($regel, $text) {

		t "'onvolledig' is true, nothing more to write";

    	    s/^\s+//; s/\s+$//;

		t 'process_details_page() RETURNING';

    	}

		return 'END';

	    }

    	if ($regel eq '') {

	    else {

    	    # Continuation of the previous one, hopefully.

		# Extract time strings from the text, but not full

    	    $regel = $last;

		# Date::Manip objects.

    	}

		#

    	else {

		$van = time_van_str($text);

    	    # They usually end with a colon but not always.

		$tot = time_tot_str($text);

    	    $regel =~ s/:$//;

	    }

    	    $last = $regel;

	}

    	}

	elsif ($regel eq 'Inhoud') {

	    # Empty text for this happens often, just skip it.

    	if ($regel eq 'Datum en tijdstip') {

	    push @desc, $text if $text ne '';

    	    warn "seen 'Tijdstip' twice\n" if $seen_tijdstip++;

	}

    	    if (length($text)<=16) {

	elsif ($regel eq 'Programma') {

        		t "'onvolledig' is true, nothing more to write";

	    warn "seen 'Programma' twice\n" if defined $naam;

        		t 'process_details_page() RETURNING';

	    # FIXME should really look for 'herhaling' in italics.

        		return 'END';

	    if ($text =~ s/\bherhaling\s+van\s+(\d\d?)-(\d\d?)-(\d{4})//) {

    	    }

		warn "seen previously-shown information twice\n"

            else {

		  if $previously_shown;

        		# Extract time strings from the text, but not full

		my ($dd, $mm, $yyyy) = ($1, $2, $3);

        		# Date::Manip objects.

		$previously_shown = { start => "$yyyy$mm$dd" };

        		#

		$text =~ s/^\s+//; $text =~ s/\s+$//;

        		($van,$tot) = time_to_str($text);

	    }

	        }

	    elsif ($text =~ s/herhaling\b//) {

    	}

		# Repeat, but no previous date given.  NB

    	elsif ($regel eq 'Inhoud') {

		# sometimes we see 'herhaling' without a space

    	    # Empty text for this happens often, just skip it.

		# before it, as in the redundant

    	    push @desc, $text if $text ne '';

		#

    	}

		# 'Netwerk herhalingenherhaling'

    	elsif ($regel eq 'Genre') {

		#

    	    warn "seen 'Genre' twice\n" if defined $genre;

		# Hence no \b at the start of the regexp.  We just

    	    # Empty text for this happens often, just skip it.

		# have to hope there aren't too many compound

    	    $genre = $text if $text ne '';

		# words ending in 'herhaling'.

    	}

		#

    	elsif ($regel eq 'Zender') {

		$previously_shown = {};

            # In the new layout, this field contains the logo

		$text =~ s/^\s+//; $text =~ s/\s+$//;

            # for the channel. Ignore it, because these logos

	    }

            # are too small to use in an application.

	    $naam = $text;

    	    #

	}

    	}

	elsif ($regel eq 'Genre') {

    	elsif ($regel eq 'Omroep') {

	    warn "seen 'Genre' twice\n" if defined $genre;

            # We ignore this setting, because the XMLTV format

	    # Empty text for this happens often, just skip it.

            # doesn't have room for this. In Holland, a few broadcasters

	    $genre = $text if $text ne '';

            # share the same channel.       

	}

    	    #

	elsif ($regel eq 'Zender') {

    	}

	    # I think this means 'broadcaster' but the information

    	elsif ($regel eq 'Bijzonderheden') {

	    # is redundant because we already know the channel.

    	    foreach (split /,\s*/, $text) {

	    #

        		if ($_ eq 'Teletekst ondertiteld') {

	    # Then we should check it and warn if it differs!  But

        		    # I'm guessing this means teletext subtitles :-).

	    # it does differ - every programme on the channel

        		    $teletext_sub++

	    # Nederland 1, it seems, has Zender of 'Nederland

        		      && warn 'seen teletext subtitles twice';

	    # 2'. So we just ignore this information.

        		}

	    #

        		elsif ($_ eq 'Breedbeeld uitzending') {

	}

        		    $widescreen++ && warn 'seen widescreen twice';

	elsif ($regel eq 'Omroep') {

        		}

	    # FIXME I don't know what this means (the dictionary

        		elsif (length >= 50) {

	    # says 'wireless telegraph' but that's no help) so

        		    # Some long sentence, part of description.

	    # just ignore it.

        		    push @desc, $_;

	    #

        		}

	}

        		else {

	elsif ($regel eq 'Kenmerken') {

        		    warn "unknown 'Bijzonderheden' bit $_"

	    foreach (split /,\s*/, $text) {

        		      unless $warned_regel{"Bijzonderheden: $_"}++;	

		if ($_ eq 'Teletekst ondertiteld') {

        		    push @desc, $_;

		    # I'm guessing this means teletext subtitles :-).

        		}

		    $teletext_sub++

    	    }

		      && warn 'seen teletext subtitles twice';

    	}

		}

        elsif ($regel eq 'Teletekst') {

		elsif ($_ eq 'Breedbeeld uitzending') {

            # Teletekst contains the 'teletext' page for this programme

		    $widescreen++ && warn 'seen widescreen twice';

            # This information isn't used at the moment

		}

        }

		elsif (length >= 50) {

    	elsif ($regel eq 'Presentatie') {

		    # Some long sentence, part of description.

    	    push @presenter, $text;

		    push @desc, $_;

    	}

		}

    	elsif ($regel eq 'Aflevering') {

		else {

    	    warn "seen 'Aflevering"

		    warn "unknown 'Kenmerken' bit $_"

    	      if defined $episode_num;

		      unless $warned_regel{"Kenmerken: $_"}++;	

    	    if ($text eq 'Slot') {

		    push @desc, $_;

        		# The last episode of a series.  There isn't a way to

		}

        		# store this in the current XMLTV format.

	    }

        		#

	}

        		warn "discarding 'Slot'" unless $warned_slot++;

	elsif ($regel eq 'Presentatie') {

    	    }

	    push @presenter, $text;

    	    elsif ($text =~ /^\d+$/) {

	}

        		if ($text == 0) {

	elsif ($regel eq 'Afleverings nummer') {

        		    warn "I thought episode nums on the site were from 1";

	    warn "seen 'Afleverings nummer' twice"

        		}

	      if defined $episode_num;

    	    	else {

	    if ($text eq 'Slot') {

        		    $episode_num = $text - 1;

		# The last episode of a series.  There isn't a way to

        		}

		# store this in the current XMLTV format.

    	    }

		#

    	    elsif ($text =~ /^(?:\d+-)+\d$/) {

		warn "discarding 'Slot'" unless $warned_slot++;

    	    	# This means multiple episodes.  This ought to be

	    }

        		# handled by turning the programme into a clump.

	    elsif ($text =~ /^\d+$/) {

        		#

		if ($text == 0) {

        		warn "programme covers multiple episodes ($text), not handled";

		    warn "I thought episode nums on the site were from 1";

    	    }

		}

    	    else {

		else {

        		warn "bad episode number $text";

		    $episode_num = $text - 1;

    	    }

		}

    	}

	    }

    	elsif ($regel eq 'Titel aflevering') {

	    elsif ($text =~ /^(?:\d+-)+\d$/) {

    	    warn "seen 'Titel aflevering' twice"

		# This means multiple episodes.  This ought to be

    	      if defined $sub_title;

		# handled by turning the programme into a clump.

    	    $sub_title = $text;

		#

    	}

		warn "programme covers multiple episodes ($text), not handled";

    	elsif ($regel eq 'Url') {

	    }

    	    # We have to turn the string given, which is normally

	    else {

    	    # just a hostname, into a URL.  I don't see why they

		warn "bad episode number $text";

    	    # don't just link to it directly, this is a web site

	    }

    	    # after all.

	}

    	    #

	elsif ($regel eq 'Titel aflevering') {

    	    # Anyway, the URI library doesn't seem to have any way

	    warn "seen 'Titel aflevering' twice"

    	    # to take a string and turn it into a URL adding

	      if defined $sub_title;

    	    # 'http:' if necessary, so we do this by hand.

	    $sub_title = $text;

    	    #

	}

    	    if ($text !~ tr/://) {

	elsif ($regel eq 'Webpagina') {

        		$text = "http://$text";

	    # We have to turn the string given, which is normally

    	    }

	    # just a hostname, into a URL.  I don't see why they

    	    push @url, $text;

	    # don't just link to it directly, this is a web site

    	}

	    # after all.

    	elsif ($regel eq 'Acteurs') {

	    #

    	    warn "seen 'Rolverdeling' twice" if $actors;

	    # Anyway, the URI library doesn't seem to have any way

	    # to take a string and turn it into a URL adding

    	    # 'e.a' appearing in the description means 'and others';

	    # 'http:' if necessary, so we do this by hand.

    	    # it's implicit in XMLTV that there might be other actors,

	    #

    	    # so we quietly remove it.

	    if ($text !~ tr/://) {

    	    #

		$text = "http://$text";

    	    $text =~ s/\s*e\.a\s*$//;

	    }

	    push @url, $text;

    	    while (length $text) {

	}

        		if ($text =~ s/\s*([^:]+):\s*([^.]+)(?:$|\.)//) {

	elsif ($regel eq 'Rolverdeling') {

        		    warn "discarding information about the parts played by each actor\n"

	    warn "seen 'Rolverdeling' twice" if $actors;

        		      unless $warned_discarding_parts++;

        		    push @$actors, $2;

	    # 'e.a' appearing in the description means 'and others';

        		}

	    # it's implicit in XMLTV that there might be other actors,

        		elsif ($text =~ s/\s*([^,]+)(?:$|,)//) {

	    # so we quietly remove it.

        		    push @$actors, $1;

	    #

        		}

	    $text =~ s/\s*e\.a\s*$//;

        		else {

        		    warn "unknown remnant 'Rolverdeling' text '$text'";

	    while (length $text) {

        		    last;

		if ($text =~ s/\s*([^:]+):\s*([^.]+)(?:$|\.)//) {

        		}

		    warn "discarding information about the parts played by each actor\n"

    	    }

		      unless $warned_discarding_parts++;

    	}

		    push @$actors, $2;

    	elsif ($regel eq 'Scenario') {

		}

    	    warn "seen 'Scenario' twice" if $writers;

		elsif ($text =~ s/\s*([^,]+)(?:$|,)//) {

    	    push @$writers, $text;

		    push @$actors, $1;

    	}

		}

    	elsif ($regel eq 'Email') {

		else {

    	    push @url, "mailto:$text";

		    warn "unknown remnant 'Rolverdeling' text '$text'";

    	}

		    last;

    	elsif ($regel eq 'Bron') {

		}

    	    # FIXME cannot do anything special with this.  It

	    }

    	    # means 'source' and perhaps by parsing the text we

	}

    	    # could find the names of writers or whatever.

	elsif ($regel eq 'Scenario schrijver') {

    	    #

	    warn "seen 'Scenario schrijver' twice" if $writers;

    	    # push @desc, "$regel: $text";

	    push @$writers, $text;

    	}

	}

    	elsif ($regel eq 'Commentaar') {

	elsif ($regel eq 'E-mail') {

    	    push @$commentators, $text;

	    push @url, "mailto:$text";

    	}

	}

    	elsif ($regel eq 'Jaar van premiere') {

	elsif ($regel eq 'Bron') {

    	    # Year of release, I think.

	    # FIXME cannot do anything special with this.  It

    	    warn "seen 'Jaar van premiere' twice"

	    # means 'source' and perhaps by parsing the text we

    	      if defined $date;

	    # could find the names of writers or whatever.

    	    $date = $text;

	    #

    	}

	    push @desc, "$regel: $text";

    	elsif ($regel eq 'Regisseur') {

	}

    	    warn "seen 'Regisseur' twice" if defined $director;

	elsif ($regel eq 'Commentaar') {

    	    $director = $text;

	    push @$commentators, $text;

    	}

	}

    	elsif ($regel eq 'Orginele titel') {

	elsif ($regel eq 'Jaar van premiere') {

    	    warn "seen 'Orginele titel' twice" if defined $orig_title;

	    # Year of release, I think.

    	    $orig_title = $text;

	    warn "seen 'Jaar van premiere' twice"

    	}

	      if defined $date;

    	elsif ($regel eq 'Behaalde prijzen') {

	    $date = $text;

    	    # Awards won.  It doesn't seem worth adding a separate

	}

    	    # field for this to the XMLTV format, just append to

	elsif ($regel eq 'Regisseur') {

    	    # the description.

	    warn "seen 'Regisseur' twice" if defined $director;

    	    #

	    $director = $text;

    	    # push @desc, "$regel: $text";

	}

    	}

	elsif ($regel eq 'Orginele titel') {

    	elsif ($regel eq 'Website') {

	    warn "seen 'Orginele titel' twice" if defined $orig_title;

    	    push @url, ($text =~ /^[a-z]+:/) ? $text : "http://$text";

	    $orig_title = $text;

    	}

	}

    	else {

	elsif ($regel eq 'Behaalde prijzen') {

    	    # Unknown key, report it back to the prompt

	    # Awards won.  It doesn't seem worth adding a separate

    	    #

	    # field for this to the XMLTV format, just append to

    	    warn "unknown programme info key $regel\n"

	    # the description.

    	      unless $warned_regel{$regel}++;

	    #

    	}

	    push @desc, "$regel: $text";

	}

	elsif ($regel eq 'Website') {

	    push @url, ($text =~ /^[a-z]+:/) ? $text : "http://$text";

	}

	else {

	    # Unknown key, but let's add it to the desc so we

	    # don't lose information.  These newlines are just for

	    # the benefit of someone reading the XML by hand.

	    #

	    push @desc, "$regel: $text";

	    warn "unknown programme info key $regel\n"

	      unless $warned_regel{$regel}++;

	}

	warn "did not see programme title, skipping programme\n";

    	warn "did not see programme title, skipping programme\n";

	return;

    	return;

	warn "did not see programme times, skipping programme\n";

       	warn "did not find programme starttime, skipping programme\n";

	return;

    	return;

    }

    if (not defined $tot) {

       	warn "did not see programme endtime, skipping programme\n";

    	return;

sub time_tot_str( $ ) {

sub time_to_str( $ ) {

    return "$yyyy-$mm-$dd $HH:$MM:00";

    # Replace months

}

	$input =~ s/\bjanuari\b/1/g;

sub time_van_str( $ ) {

	$input =~ s/\bfebruari\b/2/g;

    my $input = shift;

	$input =~ s/\bmaart\b/3/g;

    if (length($input) == 15) {

	$input =~ s/\bapril\b/4/g;

	$input .= '06:00';

	$input =~ s/\bmei\b/5/g;

	$input =~ s/\bjuni\b/6/g;

	$input =~ s/\bjuli\b/7/g;

	$input =~ s/\baugustus\b/8/g;

	$input =~ s/\bseptember\b/9/g;

	$input =~ s/\boktober\b/10/g;

	$input =~ s/\bnovember\b/11/g;

	$input =~ s/\bdecember\b/12/g;

    if( $input =~ /(\d\d?) (\d{1,2}) (\d{4}), (\d\d:\d\d)-(\d\d:\d\d) uur/ ) {

    	return ( "$3-$2-$1 $4:00", "$3-$2-$1 $5:00" );

    }

    elsif( $input =~ /(\d\d?) (\d{1,2}) (\d{4}), -(\d\d):(\d\d) uur/ ) {

    	return ( "$4-$3-$2 $4:".($5-30).":00", "$3-$2-$1 $4:$5:00" );

    }

    elsif( $input =~ /(\d\d?) (\d{1,2}) (\d{4}), (\d\d):(\d\d)- uur/ ) {

    	return ( "$3-$2-$1 $4:$5:00", "$3-$2-$1 $4:".($5+30).":00" );

	# Download what we can.

    	# Download what we can.

	my $url = 'http://www.tvgids.nl';

    	my $url = 'http://www.tvgids.nl';

	#All stations are in the select box.

    	#All stations are in the select box.

	#The station ID is the option value

    	#The station ID is the option value

	my $t = new HTML::TreeBuilder();

    	my $t = new HTML::TreeBuilder();

	$t->parse(get_nice($url));

    	$t->parse(get_nice($url));

	my @conts = map { [ $_->content_list() ] }

    	my @conts = map { [ $_->content_list() ] }

	  $t->look_down('_tag' => 'select', 'name' => 'station');

    	  $t->look_down('_tag' => 'select', 'name' => 'station');

	foreach my $cont (@conts) {

	    my @children =@$cont;

    	foreach my $cont (@conts) {

	    if (scalar(@children) == 0) {

    	    my @children =@$cont;

		warn 'No stations are defined';

		next;

    	    if (scalar(@children) == 0) {

	    }

        		warn 'No stations are defined';

	    foreach my $station_line (@children) {

    	    	next;

		if ($station_line ne ' ') {

            }

		    #This if statement is to prevent parsing the last

		    #empty element from the list.

    	    foreach my $station_line (@children) { 

        		if ($station_line ne ' ') {

		    my $channel_id = $station_line->attr('value');

    	    	    # This if statement is to prevent parsing the last

    		        # empty element from the list.

		    #I am only interested in the normal channels.

		    #tvgids.nl has some pages for the regional stations also

        		    my $channel_id = $station_line->attr('value');

		    #All normal channels have id <0,100>

		    #That is at the moment... Could change in future...

    	    	    # I am only interested in the normal channels.

		    if ($channel_id > 0 && $channel_id < 100) {

    		        # tvgids.nl has some pages for the regional stations also

			my $channel_name = $station_line->as_text();

        		    # All normal channels have id <0,300>

			$channels{$channel_id} = $channel_name

    	    	    # That is at the moment... Could change in future...

		    }

    		        if ($channel_id && $channel_id > 0 && $channel_id < 300) {

		}

                        print $channel_id."\n";

        			    my $channel_name = $station_line->as_text();

	    }

            			$channels{$channel_id} = $channel_name

	}	

    	            }

	$t->delete(); undef $t;

        		}

    	    }

    	}	

    	$t->delete(); undef $t;

	warn "$url: $_[0]";

    	warn "$url: $_[0]";

	die "$url: $_[0]";

    	die "$url: $_[0]";

    my %interesting; ++ $interesting{$_} foreach

    my @elems = $t->look_down('_tag' => 'table', 'class' => 'overzicht');

      qw(lijst_zender lijst_tijd details_programma);

    my @elems = $t->look_down(sub { die if not defined $_[0];

				    my $c = $_[0]->attr('class');

				    return 0 if not defined $c;

				    return $interesting{$c} });

	warn 'did not find any programmes in page';

    	warn 'did not find any programmes in page';

	return ();

    	return ();

	my $class = $e->attr('class');

    	my @cont = $e->look_down('_tag' => 'tr');

	t "looking at elem of class $class";

        my @elems = $t->look_down('_tag' => 'table', 'class' => 'overzicht');

	my $href;

      check_content:

        if (not @elems) {

	my @cont = $e->content_list();

        	warn 'did not find any programmes in page';

	my $got_href = $e->attr('href');

        	return ();

	if (defined $got_href) {

        }

	    t "got href: $got_href";

	    warn "seen 'href's contained inside each other"

	      if defined $href;

	    $href = $got_href;

	}

	if (not @cont) {

	    warn "found $class elem without content, ignoring"

	      unless $class eq 'lijst_zender';

	    next;

	}

	elsif (@cont == 1) {

	    for ($cont[0]) {

		if (ref) {

		    # Unpack this extra layer of element.

		    $e = $_;

		    goto check_content;

		}

		s/^\s+//; s/\s+$//;

		push @bits, [ $class, $href, $_ ];

	    }

	}

	elsif (@cont > 1) {

	    warn "found $class elem with more than one elem inside, ignoring"

	      unless $class eq 'lijst_zender';

	    next;

	}

    $t->delete(); undef $t;

    foreach my $e (@elems) {

       	my @h4elems = $e->look_down('_tag' => 'h4');

        if (not @h4elems) {

            warn 'did not find any date in page';

            return ();

        }

        else {

            push @bits, [ $h4elems[0]->as_text(), $_ ];

        }

    	my @cont = $e->look_down('_tag' => 'tr');

        foreach my $tr (@cont) {

            # Fetch the time

            my @ths = $tr->look_down('_tag' => 'th');

            my @tds = $tr->look_down('_tag' => 'td');

            if( @ths == 1 and @tds > 1 ) {

                my $th = $ths[0]; my $td1 = $tds[0]; my $td2 = $tds[1];

                my @ahs = $td1->look_down('_tag' => 'a');

                if( @ahs == 1 ) {

                    push @bits, [ $th->as_text(), $td1->as_text(), $td2->as_text(), $ahs[0]->attr('href'), $_ ];

                }

            }

        }

    }

    $t->delete();

    undef $t;

	warn "did not see any content, skipping page";

    	warn "did not see any content, skipping page";

	return ();

    	return ();

    if ($bits[0]->[0] eq 'lijst_zender') {

	my $date_str = $bits[0]->[2];

   	my $date_str = $bits[0]->[0];

	my $d = parse_dutch_date($date_str);

   	my $d = parse_dutch_date($date_str);

	if (defined $d) {

   	if (defined $d) {

	    my ($d_base, $d_tz) = @{date_to_local($d, $TZ)};

   	    my ($d_base, $d_tz) = @{date_to_local($d, $TZ)};

	    die "date in page $d_base ($date_str) doesn't match expected $official_day"

   	    die "date in page $d_base ($date_str) doesn't match expected $official_day"

	      if UnixDate($d_base, '%Q') ne UnixDate($official_day, '%Q');

   	      if UnixDate($d_base, '%Q') ne UnixDate($official_day, '%Q');

	    shift @bits;

   	    shift @bits;

	}

   	}

	# otherwise, leave it for later processing

    }

    while (@bits >= 3) {

	my $ch_bit = shift @bits;

    while (@bits > 0) {

	my $ch_class = $ch_bit->[0];

    	my $bit = shift @bits;

	if ($ch_class ne 'lijst_zender') {

	    warn "bit expected to be channel name has class $ch_class not lijst_zender, skipping";

    	my $ch = $bit->[2];

	    next;

    	t 'shifted bit to get $ch=' . d $ch;

	}

    	for ($$ch_name_ref) {

	my $ch = $ch_bit->[2];

    	    if (not defined) { $_ = $ch }

	t 'shifted bit to get $ch=' . d $ch;

       	    elsif ($_ ne $ch) {

	for ($$ch_name_ref) {

        		# Most likely the channels file has the wrong name.

	    if (not defined) { $_ = $ch }

        		warn "expected channel name $_, got $ch\n"

	    elsif ($_ ne $ch) {

        		  unless $warned_bad_channel_name{$_}{$ch}++;

		# Most likely the channels file has the wrong name.

        		$_ = $ch;

		warn "expected channel name $_, got $ch\n"

    	    }

		  unless $warned_bad_channel_name{$_}{$ch}++;

    	}

		$_ = $ch;

	    }

	}

	my $times_bit = shift @bits;

    	my $times = $bit->[0];

	my $times_class = $times_bit->[0];

    	t 'shifted bit to get $times=' . d $times;

	if ($times_class ne 'lijst_tijd') {

	    warn "bit expected to be times has class $times_class not lijst_tijd, skipping";

    	my $title_href = $bit->[3];

	    next;

    	my $title = $bit->[1];

	}

    	t 'shifted bit to get $title_href=' . d $title_href . ', '

	my $times = $times_bit->[2];

    	  . '$title=' . d $title;

	t 'shifted bit to get $times=' . d $times;

    	if ($title =~ /^Ieder heel uur .+, tenzij anders vermeld$/) {

    	    # A certain programme on the hour.  But it isn't worth

    	    # adding this to the output, ignore it.

    	    #

    	    next;

    	}

    	if ($title eq 'NB: Programmering onder voorbehoud') {

    	    # Programming subject to change.  There isn't a way to

    	    # represent this in the current XMLTV format.

    	    #

    	    next;

    	}

	my $title_bit = shift @bits;

       	my ($start_hhmm, $stop_hhmm);

	my $title_class = $title_bit->[0];

    	if ($times =~ /^(\d\d):(\d\d) - /

	if ($title_class ne 'details_programma') {

    	    and 0 <= $1 and $1 < 24 and 0 <= $2 and $2 < 60) {

	    warn "bit expected to be title has class $title_class not details_programma, skipping";

    	    $start_hhmm = "$1:$2";

	    next;

    	}

	}

    	if ($times =~ / - (\d\d):(\d\d)$/

	my $title_href = $title_bit->[1];

    	    and 0 <= $1 and $1 < 24 and 0 <= $2 and $2 < 60) {

	my $title = $title_bit->[2];

    	    $stop_hhmm = "$1:$2";

	t 'shifted bit to get $title_href=' . d $title_href . ', '

    	}

	  . '$title=' . d $title;

    	# Right, got channel name, times, and title.

	if ($title =~ /^Ieder heel uur .+, tenzij anders vermeld$/) {

    	# FIXME should check channel name (among other things).

	    # A certain programme on the hour.  But it isn't worth

    	#

	    # adding this to the output, ignore it.

       	my $title_url = URI->new_abs($title_href, $url);

	    #

	    next;

       	# We prefer to handle URLs as strings.

	}

       	push @todo, [ $start_hhmm, $stop_hhmm, $title, "$title_url" ];

	if ($title eq 'NB: Programmering onder voorbehoud') {

	    # Programming subject to change.  There isn't a way to

	    # represent this in the current XMLTV format.

	    #

	    next;

	}

	my ($start_hhmm, $stop_hhmm);

	if ($times =~ /^(\d\d):(\d\d)-/

	    and 0 <= $1 and $1 < 24 and 0 <= $2 and $2 < 60) {

	    $start_hhmm = "$1:$2";

	}

	if ($times =~ /-(\d\d):(\d\d)$/

	    and 0 <= $1 and $1 < 24 and 0 <= $2 and $2 < 60) {

	    $stop_hhmm = "$1:$2";

	}

	# Right, got channel name, times, and title.

	# FIXME should check channel name (among other things).

	#

	my $title_url = URI->new_abs($title_href, $url);

	# We prefer to handle URLs as strings.

	push @todo, [ $start_hhmm, $stop_hhmm, $title, "$title_url" ];

	my ($start_hhmm, $stop_hhmm) = @{$todo[$i]};

    	my ($start_hhmm, $stop_hhmm) = @{$todo[$i]};

	t '$start_hhmm=' . d $start_hhmm;

    	t '$start_hhmm=' . d $start_hhmm;

	t '$stop_hhmm=' . d $stop_hhmm;

    	t '$stop_hhmm=' . d $stop_hhmm;

	next if not defined $start_hhmm;

    	next if not defined $start_hhmm;

	next if not defined $stop_hhmm;

    	next if not defined $stop_hhmm;

	my $start = parse_local_date("$day $start_hhmm", $TZ);

    	my $start = parse_local_date("$day $start_hhmm", $TZ);

	my $stop = parse_local_date("$day $stop_hhmm", $TZ);

    	my $stop = parse_local_date("$day $stop_hhmm", $TZ);

	t "checking if $start -> $stop goes backwards";

    	t "checking if $start -> $stop goes backwards";

	next if Date_Cmp($start, $stop) <= 0;

    	next if Date_Cmp($start, $stop) <= 0;

	t "yup, it's a candidate";

    	t "yup, it's a candidate";

	my $stop_next_day = parse_local_date("$next_day $stop_hhmm", $TZ);

    	my $stop_next_day = parse_local_date("$next_day $stop_hhmm", $TZ);

	die if Date_Cmp($stop_next_day, $start) <= 0;

    	die if Date_Cmp($stop_next_day, $start) <= 0;

	t 'if it were, stop time on next day would be: ' . d $stop_next_day;

    	t 'if it were, stop time on next day would be: ' . d $stop_next_day;

	my $distance = Delta_Format(DateCalc($start, $stop_next_day), 0, '%st');

    	my $distance = Delta_Format(DateCalc($start, $stop_next_day), 0, '%st');

	t '...and length of programme: ' . d $distance;

    	t '...and length of programme: ' . d $distance;

	t 'shortest length so far: ' . d $shortest;

    	t 'shortest length so far: ' . d $shortest;

	if (not defined $shortest or $distance < $shortest) {

	    t 'this is the best so far';

    	if (not defined $shortest or $distance < $shortest) {

	    $shortest = $distance;

    	    t 'this is the best so far';

	    $crossing_at = $i;

    	    $shortest = $distance;

	}

    	    $crossing_at = $i;

    	}

	push @$_, $day, $day foreach @todo;

    	push @$_, $day, $day foreach @todo;

	for (my $i = 0; $i < $crossing_at; ++$i) {

    	for (my $i = 0; $i < $crossing_at; ++$i) {

	    push @{$todo[$i]}, $day, $day;

    	    push @{$todo[$i]}, $day, $day;

	}

    	}

	for (my $i = $crossing_at) {

    	for (my $i = $crossing_at) {

	    push @{$todo[$i]}, $day, $next_day;

    	    push @{$todo[$i]}, $day, $next_day;

	}

    	}

	for (my $i = $crossing_at + 1; $i < @todo; ++$i) {

    	for (my $i = $crossing_at + 1; $i < @todo; ++$i) {

	    push @{$todo[$i]}, $next_day, $next_day;

    	    push @{$todo[$i]}, $next_day, $next_day;

	}

    	}

	my ($start_hhmm, $stop_hhmm, $title, $title_url, $start_day, $stop_day) = @$_;

    	my ($start_hhmm, $stop_hhmm, $title, $title_url, $start_day, $stop_day) = @$_;

	my ($start, $stop);

    	my ($start, $stop);

	if (defined $start_hhmm) {

    	if (defined $start_hhmm) {

	    $start = parse_local_date("$start_day $start_hhmm", $TZ);

    	    $start = parse_local_date("$start_day $start_hhmm", $TZ);

	}

	    }

	if (defined $stop_hhmm) {

    	if (defined $stop_hhmm) {

	    $stop = parse_local_date("$stop_day $stop_hhmm", $TZ);

    	    $stop = parse_local_date("$stop_day $stop_hhmm", $TZ);

	}

    	}

	push @r, [ $start, $stop, $title, $title_url ];

    	push @r, [ $start, $stop, $title, $title_url ];

	our ($start, $stop);

    	our ($start, $stop);

	local (*start, *stop) = \ ($_->[0], $_->[1]);

    	local (*start, *stop) = \ ($_->[0], $_->[1]);

	t 'checking dates, $last_start=' . d $last_start;

    	t 'checking dates, $last_start=' . d $last_start;

	t '$start=' . d $start;

    	t '$start=' . d $start;

	t '$stop=' . d $stop;

    	t '$stop=' . d $stop;

	if (defined $start and defined $stop

	    and Date_Cmp($start, $stop) > 0) {

    	if (defined $start and defined $stop

	    # Appears to stop before it starts.  Assume the stop time

	      and Date_Cmp($start, $stop) > 0) {

	    # is bogus but the start time might be okay.

    	    # Appears to stop before it starts.  Assume the stop time

	    #

    	    # is bogus but the start time might be okay.

	    undef $stop;

    	    #

	}

    	    undef $stop;

	if (defined $last_start) {

    	}

	    if (defined $start and Date_Cmp($start, $last_start) < 0) {

		# Appears to start before previous start.

    	if (defined $last_start) {

		undef $start;

    	    if (defined $start and Date_Cmp($start, $last_start) < 0) {

	    }

    		# Appears to start before previous start.

    		undef $start;

        }

		# Stops before previous start - that's just as bad.

    		# Stops before previous start - that's just as bad.

		undef $stop;

    		undef $stop;

	my ($type, $href, $text) = @$_;

        my ($type, $href, $text) = @$_;

	if ($type eq 'lijst_zender' and $text eq 'Volgende') {

       	if ($type eq 'lijst_zender' and $text eq 'Volgende') {

	    # Next page for this day.

       	    # Next page for this day.

	    my $next_url = URI->new_abs($href, $url);

            my $next_url = URI->new_abs($href, $url);

	    # Turn URL back into a string.

      	    # Turn URL back into a string.

	    push @r, process_summary_page("$next_url", $day, $official_day, $ch_name_ref)

       	    push @r, process_summary_page("$next_url", $day, $official_day, $ch_name_ref)

	}

       	}

	elsif ($type eq 'lijst_zender' and $text eq 'Vorige') {

       	elsif ($type eq 'lijst_zender' and $text eq 'Vorige') {

	    # Previous page for this day, assume already fetched.

       	    # Previous page for this day, assume already fetched.

	}

       	}

	else {

       	else {

	    warn "discarding leftover $type: $text";

          	    warn "discarding leftover $type: $text";

	}

       	}

	s/\bzondag\b/Sunday/g;

	s/\bZondag\b/Sunday/g;

	s/\bmaandag\b/Monday/g;

	s/\bMaandag\b/Monday/g;

	s/\bdinsdag\b/Tuesday/g;

	s/\bDinsdag\b/Tuesday/g;

	s/\bwoensdag\b/Wednesday/g;

	s/\bWoensdag\b/Wednesday/g;

	s/\bdonderdag\b/Thursday/g;

	s/\bDonderdag\b/Thursday/g;

	s/\bvrijdag\b/Friday/g;

	s/\bVrijdag\b/Friday/g;

	s/\bzaterdag\b/Saturday/g;

	s/\bZaterdag\b/Saturday/g;