#!/usr/bin/perl -w

=pod

=head1 NAME

tv_grab_se - Grab TV listings for Sweden.

=head1 SYNOPSIS

tv_grab_se --help

tv_grab_se [--config-file FILE] --configure [--gui OPTION]

tv_grab_se [--config-file FILE] [--output FILE] [--days N]
           [--offset N] [--quiet] [--debug]

=head1 DESCRIPTION

Output TV and listings in XMLTV format for many stations
available in Sweden.  The data comes from the website of each
respective TV-station.

First you must run B<tv_grab_se --configure> to choose which stations
you want to receive.

Then running B<tv_grab_se> with no arguments will get a listings for
the stations you chose for five days including today.

B<--configure> Prompt for which stations to download and write the
configuration file.

B<--config-file FILE> Set the name of the configuration file, the
default is B<~/.xmltv/tv_grab_se.conf>.  This is the file written by
B<--configure> and read when grabbing.

B<--gui OPTION> Use this option to enable a graphical interface to be used.
OPTION may be 'Tk' or 'GDialog', or left blank for the best available choice.
Additional allowed values of OPTION are 'Term' for normal terminal output
(default) and 'TermNoProgressBar' to disable the use of Term::ProgressBar.

B<--output FILE> When grabbing, write output to FILE rather than
standard output.

B<--days N> When grabbing, grab N days rather than 5.

B<--offset N> Start grabbing at today + N days.  N may be negative.

B<--quiet> suppress the progress-bar normally shown on standard error.

B<--debug> provide more information on progress to stderr to help in
debugging.

B<--help> print a help message and exit.

=head1 ERROR HANDLING

If the grabber fails to download data for some channel on a specific day, 
it will print an errormessage to STDERR and then continue with the other
channels and days. The grabber will exit with a status code of 1 to indicate 
that the data is incomplete. 

=head1 SUPPORTED CHANNELS

tv_grab_se can currently fetch data for the following channels:

  SVT1, SVT2, Barnkanalen, SVT24,
  TV4, TV4+.
  TV3, TV8, ZTV
  VIASAT SPORT 1/2/3
  EXPLORER, ACTION/NATURE
  TV1000, CINEMA

=head1 SEE ALSO

L<xmltv(5)>

=head1 AUTHOR

Mattias Holmlund, mattias -at- holmlund -dot- se. This documentation
and parts of the code copied from tv_grab_uk by
Ed Avis, ed -at- membled -dot- com.

=head1 BUGS

The grabber for Viasat (TV3, TV8 and ZTV) does not fetch any desriptions
for the programmes, since it would then have to fetch one html-page
per programme. It does however store a url for each programme where the
description can be found.

=cut

use strict;

use XMLTV;
use XMLTV::Ask;
use XMLTV::ProgressBar;
use XMLTV::Config_file;
use XMLTV::Get_nice qw(get_nice);
use XMLTV::Memoize;
XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux');

use XMLTV::DST;

use XML::LibXML;
use Date::Manip;
use Getopt::Long;
use URI;

# The timezone for Sweden during wintertime.
use constant LOCAL_TZ => "+0100";

# We assume most site data is in this language.
use constant LANG => 'sv';

# List all available channels along with the grabber for them
# and the parameters to send to the grabber.
my %channels = (

                 #
                 # Swedish channels
                 #

                 'svt1.svt.se' =>
                 [ "SVT1", \&get_data_svt,
                   8759, "SgSVT1BG", "SgSVT1Title"  ],

                 'svt2.svt.se' =>
                 [ "SVT2", \&get_data_svt,
                   8760, "SgSVT2BG", "SgSVT2Title"  ],

                 'svt24.svt.se' =>
                 [ "SVT24", \&get_data_svt,
                   8761, "Sg24BG", "Sg24Title"  ],

                 'barnkanalen.svt.se' =>
                 [ "Barnkanalen", \&get_data_svt,
                   8762, "SgBARNKANALENBG",
                   "SgBARNKANALENTitle"  ],
                
                 'tv4.se' =>
                 [ "TV4", \&get_data_tv4,
                   1  ],

                 'plus.tv4.se' =>
                 [ "TV4+", \&get_data_tv4,
                   3  ],

                 'tv3.se' =>
                 [ "TV 3 Sverige", \&get_data_viasat,
                   "www.tv3.se", "sv" ],

                 'tv8.se' =>
                 [ "TV8", \&get_data_viasat,
                   "www.tv8.se", "sv" ],

                 'ztv.se' =>
                 [ "ZTV Sverige", \&get_data_viasat,
                   "www.ztv.se", "sv" ],

                 'tv1000.viasat.se' =>
                 [ "TV 1000 Sverige", \&get_data_viasat_tv1000,
                   "www.tv1000.se", "sv", 1, 0],

                 'plus-1.tv1000.viasat.se' =>
                 [ "TV 1000 Sverige (delayed one hour)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.se", "sv", 1, 1],

                 'plus-2.tv1000.viasat.se' =>
                 [ "TV 1000 Sverige (delayed two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.se", "sv", 1, 2],

                 'cinema.viasat.se' =>
                 [ "Viasat Cinema Sverige", \&get_data_viasat_tv1000,
                   "www.tv1000.se", "sv", 3, 0],

                 'plus-1.cinema.viasat.se' =>
                 [ "Viasat Cinema Sverige (delayed one hour)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.se", "sv", 3, 1],

                 'plus-2.cinema.viasat.se' =>
                 [ "Viasat Cinema Sverige (delayed two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.se", "sv", 3, 2],

                 'sport1.viasat.se' =>
                 [ "Viasat Sport 1 Sverige", \&get_data_viasat,
                   "www.sport.viasat.se", "sv" ],

                 'sport2.viasat.se' =>
                 [ "Viasat Sport 2 Sverige", \&get_data_viasat,
                   "www.sport.viasat.se", "sv", "&override_section=76" ],

                 'sport3.viasat.se' =>
                 [ "Viasat Sport 3 Sverige", \&get_data_viasat,
                   "www.sport.viasat.se", "sv", "&override_section=77" ],

                 'action.viasat.se' =>
                 [ "Viasat Nature Action Sverige", \&get_data_viasat,
                   "www.action.viasat.se", "sv" ],

                 'explorer.viasat.se' =>
                 [ "Viasat Explorer Sverige", \&get_data_viasat,
                   "explorer.viasat.se", "sv" ],

                 #
                 # Danish channels
                 #

                 '3plus.dk' =>
                 [ "3+ Denmark", \&get_data_viasat,
                   "www.3plus.dk", "dk" ],				 
				 
                 'sport1.viasat.dk' =>
                 [ "Viasat Sport 1 Denmark", \&get_data_viasat,
                   "www.sport.viasat.dk", "dk" ],

                 'sport2.viasat.dk' =>
                 [ "Viasat Sport 2 Denmark", \&get_data_viasat,
                   "www.sport.viasat.dk", "dk", "&override_section=76" ],

                 'sport3.viasat.dk' =>
                 [ "Viasat Sport 3 Denmark", \&get_data_viasat,
                   "www.sport.viasat.dk", "dk", "&override_section=77" ],

                 'action.viasat.dk' =>
                 [ "Viasat Nature Action Denmark", \&get_data_viasat,
                   "www.action.viasat.dk", "dk" ],

                 'explorer.viasat.dk' =>
                 [ "Viasat Explorer Denmark", \&get_data_viasat,
                   "explorer.viasat.dk", "dk" ],

                 'tv1000.viasat.dk' =>
                 [ "TV 1000 Denmark", \&get_data_viasat_tv1000,
                   "www.tv1000.dk", "dk", 1, 0],

                 'plus-1.tv1000.viasat.dk' =>
                 [ "TV 1000 Denmark (delayed one hour)", \
                   &get_data_viasat_tv1000,
                   "www.tv1000.dk", "dk", 1, 1],

                 'plus-2.tv1000.viasat.dk' =>
                 [ "TV 1000 Denmark (delayed two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.dk", "dk", 1, 2],

                 'cinema.viasat.dk' =>
                 [ "Viasat Cinema Denmark", \&get_data_viasat_tv1000,
                   "www.tv1000.dk", "dk", 3, 0],

                 'plus-1.cinema.viasat.dk' =>
                 [ "Viasat Cinema Denmark (delayed one hour)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.dk", "dk", 3, 1],

                 'plus-2.cinema.viasat.dk' =>
                 [ "Viasat Cinema Denmark (delayed two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.dk", "dk", 3, 2],

                
                 'tv3.dk' =>
                 [ "TV 3 Denmark", \&get_data_viasat,
                   "www.tv3.dk", "dk" ],

                 #
                 # Norwegian channels
                 #

                 'tv3.no' =>
                 [ "TV 3 Norge", \&get_data_viasat,
                   "www.tv3.no", "no" ],

                 'ztv.no' =>
                 [ "ZTV Norge", \&get_data_viasat,
                   "www.ztv.no", "no" ],

                 'sport1.viasat.no' =>
                 [ "Viasat Sport 1 Norway", \&get_data_viasat,
                   "www.sport.viasat.no", "no" ],

                 'sport2.viasat.no' =>
                 [ "Viasat Sport 2 Norway", \&get_data_viasat,
                   "www.sport.viasat.no", "no", "&override_section=76" ],

                 'sport3.viasat.no' =>
                 [ "Viasat Sport 3 Norway", \&get_data_viasat,
                   "www.sport.viasat.no", "no", "&override_section=77" ],

                 'action.viasat.no' =>
                 [ "Viasat Nature Action Norway", \&get_data_viasat,
                   "www.action.viasat.no", "no" ],

                 'explorer.viasat.no' =>
                 [ "Viasat Explorer Norway", \&get_data_viasat,
                   "explorer.viasat.no", "no" ],

                 'tv1000.viasat.no' =>
                 [ "TV 1000 Norway", \&get_data_viasat_tv1000,
                   "www.tv1000.no", "no", 1, 0],

                 'plus-1.tv1000.viasat.no' =>
                 [ "TV 1000 Norway (delayed one hour)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.no", "no", 1, 1],

                 'plus-2.tv1000.viasat.no' =>
                 [ "TV 1000 Norway (delayed two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.no", "no", 1, 2],

                 'cinema.viasat.no' =>
                 [ "Viasat Cinema Norway", \&get_data_viasat_tv1000,
                   "www.tv1000.no", "no", 3, 0],

                 'plus-1.cinema.viasat.no' =>
                 [ "Viasat Cinema Norway (delayed one hour)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.no", "no", 3, 1],

                 'plus-2.cinema.viasat.no' =>
                 [ "Viasat Cinema Norway (delayed two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.no", "no", 3, 2],

                #
                # Finnish channels
                #
                
                 'tv1000.viasat.fi' =>
                 [ "TV 1000 Finland", \&get_data_viasat_tv1000,
                   "www.tv1000.fi", "fi", 1, 0],

                 'plus-1.tv1000.viasat.fi' =>
                 [ "TV 1000 Finland (delayed one hour)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.fi", "fi", 1, 1],

                 'plus-2.tv1000.viasat.fi' =>
                 [ "TV 1000 Finland (delayed two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.fi", "fi", 1, 2],

                 'cinema.viasat.fi' =>
                 [ "Viasat Cinema Finland", \&get_data_viasat_tv1000,
                   "www.tv1000.fi", "fi", 3, 0],

                 'plus-1.cinema.viasat.fi' =>
                 [ "Viasat Cinema Finland (delayed one hour)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.fi", "fi", 3, 1],

                 'plus-2.cinema.viasat.fi' =>
                 [ "Viasat Cinema Finland (delayd two hours)", 
                   \&get_data_viasat_tv1000,
                   "www.tv1000.fi", "fi", 3, 2],

                 );

my $opt = { days => 5,
            offset => 0,
            "config-file" => undef,
            gui => undef,
            configure => 0,
            help => 0,
            quiet => 0,
            output => undef,
            debug => 0,
          };

my $res = GetOptions( $opt, qw/
                      days=i
                      offset=i
                      config-file=s
                      gui
                      configure
                      help|h
                      quiet
                      output=s
                      debug
                      / );

sub t;

if( (not $res) or scalar(@ARGV) or $opt->{help} )
{
  print << 'EOH';
tv_grab_se --help

tv_grab_se [--config-file FILE] --configure [--gui OPTION]

tv_grab_se [--config-file FILE] [--output FILE] [--days N]
           [--offset N] [--quiet] [--debug]

EOH

  exit(1);
}

XMLTV::Ask::init($opt->{'gui'});
XMLTV::ProgressBar::init($opt->{'gui'});

# XMLTV::DST says that we should do this...
Date_Init('TZ=UTC');

# File that stores which channels to download.
my $config_file
  = XMLTV::Config_file::filename($opt->{'config-file' },
                                 'tv_grab_se', not $opt->{debug} );

if( $opt->{configure} )
{
    configure( $config_file );
    exit;
}

# List of the ids of all channels that should be loaded.
# This is loaded from the configuration file.
my @channel_list = ();

load_config( $config_file );

my( $odoc, $root );
my $warnings = 0;

my %w_args = ( encoding => 'ISO-8859-1' );

if (defined $opt->{output})
{
    t "Sending output to $opt->{output}.";
    my $fh = new IO::File "> $opt->{output}";
    die "cannot write to $opt->{output}" if not $fh;
    $w_args{OUTPUT} = $fh;
}

my $w = new XMLTV::Writer( %w_args );
# $w->comment("Hello from XML::Writer's comment() method");
$w->start({ 'generator-info-name' => 'tv_grab_se' });

# Write list of channels.
t 'Writing list of channels.';

foreach my $channel_id (@channel_list)
{
    my( $channel_name, $get_sub, @param ) = @{$channels{$channel_id}};
    $w->write_channel( {
        id => $channel_id,
        'display-name' => [[ $channel_name, LANG ]],
    } );
}

my $now = ParseDate( 'now' );
my $today = UnixDate( $now, "%Y%m%d" );

my $date = increase_date( $today, $opt->{offset} );

my $bar = undef;
$bar = new XMLTV::ProgressBar( {
    name => 'downloading listings',
    count => $opt->{days} * @channel_list
    }) if (not $opt->{quiet}) && (not $opt->{debug});

for( my $i=0; $i < $opt->{days}; $i++ )
{
    t "Date: $date";
    foreach my $channel_id (@channel_list)
    {
        t "  $channel_id";
        my( $channel_name, $get_sub, @param ) = @{$channels{$channel_id}};
        &{$get_sub}( $w, $channel_id, $date, @param );
        update $bar if defined( $bar );
    }

    $date = increase_date( $date, 1 );
}
$bar->finish();
$w->end();

# Signal that something went wrong if there were warnings.
exit(1) if $warnings;

# All data fetched ok.
t "Exiting without warnings.";
exit(0);

##########################################
#
# Routines common for all channels.
#
##########################################

sub parse_xml
{
    my( $html ) = @_;

    my $doc;

    # Stupid XML::LibXML writes to STDERR. Redirect it temporarily.
    open(SAVERR, ">&STDERR"); # save the stderr fhandle
    print SAVERR "Nothing\n" if 0;
    open(STDERR,"> /dev/null");

    eval
    {
        my $xml = XML::LibXML->new;
        $xml->recover(1);

        $doc = $xml->parse_html_string($html);
    };

    warning( "Error from eval: $@" ) if $@;

    # Restore STDERR
    open( STDERR, ">&SAVERR" );

    warning( "Failed to parse html" ) unless defined( $doc );
    return $doc;
}

sub increase_date
{
    my( $datestr, $delta ) = @_;

    my( $year, $month, $day ) = ( $datestr =~ /(\d\d\d\d)(\d\d)(\d\d)/ );

    my $date = ParseDate( "$year-$month-$day" );

    my $newdate = DateCalc( $date, "+ $delta days" );

    return UnixDate( $newdate, "%Y%m%d" );
}

#
# Error handling
#

sub t
{
    my( $message ) = @_;
    print STDERR $message . "\n" if $opt->{debug};
}

sub warning
{
    my( $message ) = @_;
    print STDERR $message . "\n";
    $warnings++;
}

#
# Configuration
#

sub load_config
{
    my( $config_file ) = @_;

    my @lines = XMLTV::Config_file::read_lines( $config_file );

    foreach my $line (@lines)
    {
        next unless defined $line;
        my( $command, $param ) = split( /\s+/, $line );
        die "Unknown command $command in config-file $config_file"
            unless $command =~ /^\s*channel\s*$/;

        $param =~ tr/\n\r //d;

        push @channel_list, $param;
    }
}

sub configure
{
    my( $config_file ) = @_;

    XMLTV::Config_file::check_no_overwrite( $config_file );

    # FIXME need to make directory
    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";

    my @chan = sort { join( ".", reverse( split /\./, $a ) ) cmp 
                     join( ".", reverse( split /\./, $b ) ) } 
        keys %channels;

    # Ask about Swedish channels first.
    my @all = (grep( /\.se$/, @chan ), grep( !/\.se$/, @chan ));

    my @wanted = ask_many_boolean(1,
                    map { "get channel $channels{$_}->[0] ($_)?" }
                    @all );
    foreach (@all) {
        print CONF '# ' if not shift @wanted;
        print CONF "channel $_\n";
    }
    close CONF or warn "cannot close $config_file: $!";
    say("Finished configuration.");
}


##########################################
#
# svt.se
#
##########################################

sub get_data_svt
{
    my( $w, $channel, $date, $id, $bgclass, $titleclass ) = @_;

    my( $base, $html ) = get_html_svt( $id, $date );
    if( not defined( $html ) )
    {
        warning( "Failed to fetch html for $channel on $date." );
        return;
    }

    my $doc = parse_xml( $html );

    my $lasttime = "0000";

    my $ns = $doc->find( "//tr[td/\@class='$bgclass']" );

    if( $ns->size() == 0 )
    {
        warning "No data available for $channel on $date.";
        return;
    }

    foreach my $node ($ns->get_nodelist)
    {
        my $time = $node->findvalue( "td[\@class='$bgclass']" );
        my( $starttime, $stoptime ) = ($time =~ /(\d+\.\d+)\s*-\s*(\d+\.\d+)/ );
        $starttime = $time unless defined $starttime;

        $starttime =~ tr/\.//d;
        $stoptime =~ tr/\.//d if defined $stoptime;

        my $title = $node->findvalue( ".//*[\@class='$titleclass']" );
        my $url = $node->findvalue( "(.//a)[1]/\@href" );

        # Delete character that SVT uses to signify a link.
        $title =~ tr///d;

        # Trim whitespace.
        for ($title) { s/^\s+//; s/\s+$// }

        my $description = "";

        my $ns2 = $node->find( './/div[@class="SgZText"]/div/text()' );

        foreach my $desc ($ns2->get_nodelist)
        {
            $description .= $desc->findvalue('.');
        }

        # Delete character that SVT uses to signify a link.
        $description =~ tr///d;

        if( $starttime < $lasttime )
        {
            $date = increase_date( $date, 1 );
        }

        my %d = (
                 channel => $channel,
                 start   => utc_offset( "$date$starttime", LOCAL_TZ ),
                 title   => [ [ $title, LANG ] ],
                 );

        if( defined $stoptime )
        {
            my $stopdate = $date;

            if( $stoptime < $starttime )
            {
                $stopdate = increase_date( $stopdate, 1 );
            }

            $d{stop} = utc_offset( "$stopdate$stoptime", LOCAL_TZ );
        }

	for ($description) {
	    s/^\s+//; s/\s+$//;
	    $d{desc} = [ [ $_, LANG ] ] if length;
	}

        $d{url} = [URI->new($url)->abs($base)] if $url =~ /\S/;

        $w->write_programme( \%d );

        $lasttime = $starttime;
    }
}

sub get_html_svt
{
    my( $id, $date ) = @_;

    my $url = "http://svt.se/svt/jsp/polopoly.jsp?" .
              "d=$id\&selectedDate=$date\&shortVersion=false\&x=31\&y=8";

    return ( URI->new( $url ), get_nice( $url ) );
}

##########################################
#
# tv4.se
#
##########################################

sub get_html_tv4
{
    my( $id, $date ) = @_;

    $date =~ s/(\d{4})(\d{2})(\d{2})/$1-$2-$3/;

    my $url = "http://www.tv4.se/program/tabla.aspx?date=$date";
    $url .= "\&ch=$id"; # unless $id==1;

    return ( URI->new( $url ), get_nice( $url ) );
}

sub get_data_tv4
{
    my( $w, $channel, $date, $id ) = @_;

    my( $base, $html ) = get_html_tv4( $id, $date );
    if( not defined( $html ) )
    {
        warning( "Failed to fetch html for $channel on $date." );
        return;
    }

    my $doc = parse_xml( $html );
    if( not defined( $doc ) )
    {
        warning( "Failed to parse html for $channel on $date." );
        return;
    }

    # Every odd tr contains the starttime and title. Every even tr contains
    # the description if it exists. The description can be found since it has
    # an empty first td.

    my $ns = $doc->find( "//span[\@id='LabelResults']/tr" );

    if( $ns->size() <= 2 )
    {
        warning "No data available for $channel on $date.";
        return;
    }

    my @programmes = ();

    my $lasttime = "0000";

    foreach my $node ($ns->get_nodelist)
    {
        my $time = $node->findvalue( "td[1]" );
        $time =~ tr/\n\r //d;

        my $text = $node->findvalue( "td[2]" );
        $text =~ tr/\n\r /   /s;
        $text =~ s/^\s+//;
        $text =~ s/\s+$//;

        # Delete character that TV4 uses to signify a link.
        $text =~ tr///d;

    
        if( $time =~ /^\s*\d\d:\d\d\s*$/ )
        {
            # This tr contains a time. 
            $time =~ s/^\s*(\d\d):(\d\d)\s*/$1$2/;

            if( $time < $lasttime )
            {
                $date = increase_date( $date, 1 );
            }
            
            $lasttime = $time;
            
            if( $text =~ /^\s*-S.ndningsuppeh.ll-\s*$/ )
            {
                # This entry signals that there is nothing on TV. 
                # Use the starttime of this entry as the end-time of the
                # previous entry.
                $programmes[-1]->{stop} = utc_offset( "$date$time", LOCAL_TZ );
            }
            else
            {
                my %prog = ( 
                             channel   => $channel,
                             start     => utc_offset( "$date$time", LOCAL_TZ ),
                             title     => [ [$text, LANG ] ],
                             );
                
                my $url = $node->findvalue('(td[2]//a)[1]/@href');
                $prog{url} = [URI->new($url)->abs($base)] if $url =~ /\S/;
                
                push @programmes, \%prog;
            }
        }
        else
        {
            # This tr does not contain a time. It must be a description
            # for the previous entry.
	    for ($text) {
		s/^\s+//; s/\s+$//;
                $programmes[-1]->{desc} = [ [ $_, LANG ] ] if length;
            }
        }
    }

    foreach my $prog (@programmes)
    {
        $w->write_programme( $prog );
    }
}

##########################################
#
# viasat
#
##########################################

sub get_html_viasat
{
    my( $site, $date, $url_addon) = @_;

    my( $year, $month, $day ) = ($date =~ /(\d{4})(\d{2})(\d{2})/);

    my $url = "http://$site/index.phtml?page_type=tvchart$url_addon\&" .
              "start_year=$year\&start_month=$month\&start_day=$day";

    return ( URI->new( $url ), get_nice( $url ) );
}

sub get_data_viasat
{
    my( $w, $channel, $date, $site, $language, $url_addon ) = @_;

    $url_addon = "" unless defined $url_addon;

    my( $base, $html ) = get_html_viasat( $site, $date, $url_addon );
    if( not defined( $html ) )
    {
        warning( "Failed to fetch html for $channel on $date." );
        return;
    }

    my $doc = parse_xml( $html );
    if( not defined( $doc ) )
    {
        warning( "Failed to parse html for $channel on $date." );
        return;
    }

    my $ns = $doc->find(
     '//table/tr[@class="bgcolorBoxGeneral" or @class="bgcolorBoxGeneral2"]' );

    if( $ns->size() == 0 )
    {
        warning "No data available for $channel on $date.";
        return;
    }

    my @programmes = ();

    my $lasttime = "0000";

    foreach my $node ($ns->get_nodelist)
    {
        my $starttime = $node->findvalue( "td[1]" );
        $starttime =~ tr/\n\r //d;

        my $title = $node->findvalue( "td[2]/a" );

        # Fallback in case there is no link for this programme.
        $title = $node->findvalue( "td[2]" ) if ($title =~ /^\s*$/);

        $title =~ tr/\n\r /   /s;
        $title =~ s/^\s+//;
        $title =~ s/\s+$//;

        my $url = $node->findvalue( '(td[2]/a[@class="show"])[1]/@href' );

        $starttime =~ tr/\://d;

        if( $starttime < $lasttime )
        {
            $date = increase_date( $date, 1 );
        }

        if( $title =~ /^\s*SLUT\s*$/ )
        {
            # This entry signals that there is nothing on TV. 
            # Use the starttime of this entry as the end-time of the
            # previous entry.
            $programmes[-1]->{stop} = utc_offset( "$date$starttime", 
                                                  LOCAL_TZ );
        }
        else
        {
            my %prog = ( 
              channel   => $channel,
              start     => utc_offset( "$date$starttime", LOCAL_TZ ),
              title     => [ [$title, $language ] ],
            );
            
            $prog{url} = [URI->new($url)->abs($base)] if $url =~ /\S/;        
            
            push @programmes, \%prog;
        }

        $lasttime = $starttime;
    }

    foreach my $prog (@programmes)
    {
        $w->write_programme( $prog );
    }
}

##########################################
#
# viasat TV1000
#
##########################################

sub utc_offset_shift( $$$ ) {
    my ($indate, $basetz, $shift) = @_;
    my $d = date_to_local(parse_local_date($indate, $basetz), $basetz);
    my $d_shifted = DateCalc($d->[0], "+ $shift hour", my $err);
    return UnixDate($d_shifted,"%Y%m%d%H%M%S") . " " . $d->[1];
}

sub get_data_viasat_tv1000
{
    my( $w, $channel, $date, $site, $language, $td_id, $timeshift ) = @_;
    
    my( $base, $html ) = get_html_viasat( $site, $date, "" );
    if( not defined( $html ) )
    {
        warning( "Failed to fetch html for $channel on $date." );
        return;
    }
    
    my $doc = parse_xml( $html );
    if( not defined( $doc ) )
    {
        warning( "Failed to parse html for $channel on $date." );
        return;
    }
    
    my $ns = $doc->find("//td[$td_id]/table/tr/td/div[\@class='txtBlue']" );
    
    if( $ns->size() == 0 )
    {
        warning "No data available for $channel on $date.";
        return;
    }
    
    my $lasttime = "0000";
    
    foreach my $node ($ns->get_nodelist)
    {
        my $starttime = $node->findvalue( "." );
        $starttime =~ tr/\n\r //d;
        
        my $title = $node->findvalue( "../a" );
        
        # Fallback in case there is no link for this programme.
        $title = $node->findvalue( ".." ) if ($title =~ /^\s*$/);
        
        $title =~ tr/\n\r /   /s;
        $title =~ s/^\s+//;
        $title =~ s/\s+$//;
        
        my $description = $node->findvalue( ".." );
        
        my @array = split(/\n/,$description);
        $description = $array[$#array];
        
        $description =~ s/^\s+//;
        $description =~ s/\s+$//;
        
        my $url = $node->findvalue( '(../a)[1]/@href' );
        
        $starttime =~ tr/\://d;
        
        if( $starttime < $lasttime )
        {
            $date = increase_date( $date, 1 );
        }
        
        my %d = (
                 channel => $channel,
                 start   => utc_offset_shift( "$date$starttime", 
                                              LOCAL_TZ, $timeshift ),
                 title   => [ [ $title, $language ] ],
                 );
        
	for ($description) {
	    s/^\s+//; s/\s+$//;
	    $d{desc} = [ [ $_, $language ] ] if length;
	}
        $d{url} = [URI->new($url)->abs($base)] if $url =~ /\S/;
        
        $w->write_programme( \%d );
        
        $lasttime = $starttime;
    }
}


### Setup indentation in Emacs
## Local Variables:
## perl-indent-level: 4
## perl-continued-statement-offset: 4
## perl-continued-brace-offset: 0
## perl-brace-offset: -4
## perl-brace-imaginary-offset: 0
## perl-label-offset: -2
## cperl-indent-level: 2
## cperl-brace-offset: 0
## cperl-continued-brace-offset: 0
## cperl-label-offset: -2
## cperl-extra-newline-before-brace: t
## cperl-merge-trailing-else: nil
## cperl-continued-statement-offset: 2
## End:

