#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
=pod

=head1 NAME

tv_grab_be - Grab TV listings for Belgium

=head1 SYNOPSIS

tv_grab_be --help

tv_grab_be [--config-file FILE] --configure [--slow] [--gui OPTION]

tv_grab_be [--config-file FILE] [--output FILE] [--days N]
           [--offset N] [--quiet] [--slow] [--gui OPTION]

tv_grab_be [--output FILE] [--quiet] [--config-file FILE] --list-channels

tv_grab_be --capabilities

tv_grab_be --version

=head1 DESCRIPTION

Output TV and radio listings in XMLTV format for many stations
available in Belgium.  The data comes from the Sanoma magazines'
websites: Tele Moustique and Teve Blad.

=head1 USAGE

First you must run B<tv_grab_be --configure> to choose the language,
grab mode and which stations you want to receive.  

Then running B<tv_grab_be> with no arguments will get about 6
dayE<39>s of summary only listings for the channels you chose.

If you want to grab detailed information (such as episode name,
detailed descriptions, actors) then use the B<--slow> flag when both
onfiguring and running the grabber. The configure mode will prompt
you for selection criteria for when the grabber should retrieve
detailed information for programmes (selected by start time, category,
and channel). This makes grabbing slow (hence the option name!)

Note that different stations ar available in French and Dutch modes
due to the listings differences from the two sites. The data is also 
different -- the French site has more detailed info for the french 
language channels, and the Dutch site has more info for the Dutch 
language channels.

Some channels (BBC World, Euronews) although listed, have such bad
listings data that you would be better off using the tv_grab_uk_rt
grabber, and then merging the resulting files with tv_cat!

It is perhaps worthwhile to use the --config-file option to maintain
one config file with a selection of channels for each language, then
using tv_cat to merge the resulting XML files.

B<--configure> Prompt for language, grab mode and which
stations to download and write the configuration file (see also --slow)

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

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

B<--days N> When grabbing, grab N days rather than as many as
possible.

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

B<--quiet> Suppress the progress messages normally written to standard
error.

B<--slow> Slow mode: get detailed information for specified
programmes. With B<--configure>, this enables the configuration
routine to prompt for the criteria which programs have to match for
detailed information downloading. Otherwise, this enables the grabbing
of detailed for programmes matching the defined criteria.

B<--trace> Show debug information (if L<Log::TraceMessages> is installed)

B<--gui OPTION> Use this option to enable a graphical interface to be used.
OPTION may be 'Tk', 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<--list-channels> Dump channel information for all channels but no
programmes.  This grabber needs a config file first before the
channels can be dumped.

B<--capabilities> Show which capabilities the grabber supports. For more
information, see L<http://membled.com/twiki/bin/view/Main/XmltvCapabilities>

B<--version> Show the version of the grabber.

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

=head1 WARNING

In B<--slow> mode, unning this grabber requires very many web page
fetches (one per channel per day, and then one per programme selected
for detailed information) from a very slow web site.

The number of web page fetches can be limited by limiting the number
of programs to get detailed information for (by start time range,
category or channel). This is defined when run with B<--configure
--slow> or in the config file.

=head1 SEE ALSO

L<xmltv(5)>, L<http://www.telepocket.be>, L<http://www.teveblad.be>

=head1 AUTHOR

Niel Markwick, nielm@bigfoot.com
Based on B<tv_grab_uk_rt>

=head1 BUGS

The website parsing isnE<39>t perfect and there may be warning
messages about bits of HTML that arenE<39>t understood.  Some of the
details provided by the site have to be thrown away because they
cannot be accommodated in the XMLTV format; again, warning messages
are printed.

Programmes containing defined sections are not handled very well (such
as Sportpaleis on Canvas) because the data source lists the sections
separately with overlapping timeslots. eg:

=over

=item "13.30-14.00 Hands Up!"

=item "13.30-17.30 Sportpaleis"

=item "14.00 14.30 Champions League Magazine"

=item "14.30 17.00 Wielrennen: Kuurne - Brussel - Kuurne"

=item "17.00 17.15 Autorennen: F1"

=item "17.15 17.30 Daar is 'm!"

=back



The data on the website can also be poor. Program names gain and lose
random punctuation from week to week. eg: 

=over

=item "Buffy, the Vampire Slayer.", 

=item "Buffy the Vampire Slayer", 

=item "Buffy, the Vampire Slayer",

=item "Buffy the Vampire Slayer."

=back

The grabber strips trailing punctuation to help avoid this.

Sometimes the stop time is not put on last programme of the day. This
can be worked around by piping the output through tv_sort, and the start
time of the first program of the next day will be used.
Alternatively, the following complex tv_grep command can add an 
implicit stop time of 06:00:

tv_grep -e 'if (not ${$_}{stop}) { (${$_}{stop} = ${$_}{start}) =~ s/\d{6}\b/060000/ }; 1'

Finally there are several things still to do (see TODO list in source
code for full description).

=head1 HISTORY

B<2004-01-08 nielm> - first version with selective detail grabbing,
based on tv_grab_uk_rt 0.5.27

B<2004-01-09 nielm> - Disable detail grabbing by default; implemented
--slow option to enable detail grabbing and to complicate
configuration procedure; . Removed implicit generation of stop
time. Correct windows special characters (128-159): oe ligatures ->
oe; fancy quotes -> normal quotes, others -> ? (with warning); Fixed
warning about Log::Tracemessages::On.

B<2004-01-13 nielm> - Replace '...' Windows character; Added parsing
of star ratings; warn about unrecognised images in description text;
Added parsing of movie ratings (classifications); Future-proof config
file to cope with grabbing multiple languages simultaneously; Added
--output option

B<2004-01-15 nielm> - Put year into date tag; Put director of films
(if found in descr) into director tag; Get year from descr if not
found, add channel logos (from satlogo.com).

B<2004-01-26 nielm> - handle VO/OV image without warning; make
multi-line descriptions; correct date parsing; correct episode num 
in FR listings; correct stop time bug when no stop time defined; 
removed lang=xx from title and sub-title; 

B<2004-01-29 nielm> - add icons in rating and star-rating; handle
episode numbers in titles better; handle extracting of director
better.

B<2004-02-23 nielm/epaepa> - tidy up of help text, remove newlines
from desc, improve start/stop time details matching, add detaul URL to
fast mode programme info

B<2004-03-04 nielm> - Correct usage, handle Duree (length), handle
repeats (previously-shown), handle episode numbers in description. 
More things added to TODO list (see source code)

B<2004-03-09 nielm> - Remove Duree and (R.) from description
text. Remove categories in description. Do not put episode numbers in
sub-title

B<2004-04-01 nielm> - Fixed bug with no stop time for programs
starting at midnight, handle 'New' icon, Fixed JIMTV channel ID,
handle 'Divers' tags (which may contain info on previously-shown),
remove 'gastacteurs:' from actor names.

B<2004-04-05 epaepa/nielm> - Make time zones consistantly +0100 or
+0200, but never mixed. Clean up punctuation around actor
names. Remove duplicate ChannelID from file (only put alternative
ID's). better actor parsing

B<2004-04-05 epaepa/nielm> - Handle user input better during config
(CTRL-D, CTRL-H), use substrings not regexps for category/channel
matching to avoid nastyness when a user enters a bad regexp. Add magic
category *NONE* and *ALL* for category matching.

B<2004-04-15 nielm> - yet more cleanup in parsing actor names, ignore
programmes with no titles.

B<2005-03-12 nielm> - no function changes: just changes to the
configuration section to use XMLTV::ask, and updates to the
channel_ids files

B<2005-09-22 nielm> - www.telemoustique.be no longer works: quick
and dirty fix: use www.telepocket.be instead.

=cut

# TODO
#
# Merge fr and nl configs to allow single config file.
#
#
# Handle listings where a program is shown again later in the day
# without a separate lsting for it: eg:
#    <desc lang="fr">les moments les plus delirants de
#    l'emission. (13.30, 16.15, 20.45, 0.30)</desc>
#    <desc lang="fr">Srie anime. La dcision de Petit-Coeur 
#    (R.  17.30 et 24.00)</desc>
#    <desc lang="fr">Srie australienne (R.  18.00)</desc>
# implies this program will be shown at these later times... 
# 
#
# Handle Followed by 'Suivi' in Fremch descriptions
#   <desc lang="fr">(R.) Suivi de Le Shopping.</desc>
#   <desc lang="fr">Suivi,  14.40, de Tranche de rire.</desc>
#   <desc lang="fr">suivi  14.10 de La Boutique - 14.40 Tranche de rire.</desc>
#   <desc lang="fr">Srie quotidienne franaise suivie,  19.55, de la Mto.</desc>
#   <desc lang="fr">suivi de L'invit - La mto</desc>
#   <desc lang="fr">suivi de L'invit - La mto. Pascal Vrebos reoit Laurette Onkelinx, Ministre de la Justice (PS).</desc>
#
# Handle grouped programmes
#     <desc lang="fr">Le lutin Plop
#      - 7.00 La cour de rcr (R.) 
#      - 7.25 Pepper Ann (R.) 
#      - 7.50 Jim Bouton.</desc>
#


use strict;
use XMLTV::Version '$Id: tv_grab_be.in,v 1.8 2006/04/12 16:59:52 mattiasholmlund Exp $ ';
use XMLTV::Capabilities qw/baseline manualconfig cache share/;
use XMLTV::Description 'Belgium';
use IO::Socket;
use LWP::Simple;
use Date::Manip;
use Getopt::Long;
use HTML::Entities;
use XMLTV;
use XMLTV::Memoize;
use XMLTV::Ask;
use XMLTV::ProgressBar;
use XMLTV::DST;
use XMLTV::Config_file;
use XMLTV::Get_nice; 
use XMLTV::Date qw(parse_date); 
use XMLTV::Usage <<END
To configure:     $0 --configure [--config-file FILE] [--slow] [--gui OPTION]
To grab listings: $0 [--config-file FILE] [--output FILE] 
                     [--days N] [--offset N] [--quiet] [--slow] [--gui OPTION]
To list channels: $0 [--output FILE] [--quiet] [--config-file FILE] --list-channels
To show capabilities: $0 --capabilities
To show version: $0 --version
END
  ;

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

sub get_url( $ );
sub get_programmes( $$$$$$ );
sub get_programme_summary( $$$$ );
sub get_programme_detailed_info($$);
sub parse_programme_details($$); # ref of prog hash, array of descr strings
sub get_channels();
sub get_categories();
sub get_available_dates();
sub be_to_xmltv( $ );
sub xmltv_to_be( $ );
sub grab( $$ );
sub configure();

# GLOBAL CONSTANTS
my $LANG_FR = 'fr';
my $LANG_NL = 'nl';

# language-dependant constants
my %DOMAIN = ( $LANG_FR => 'telepocket.be',
		 $LANG_NL => 'teveblad.be' );
my %BASE_URL = ( $LANG_FR => "http://www.$DOMAIN{$LANG_FR}/fr/",
		 $LANG_NL => "http://www.$DOMAIN{$LANG_NL}/ndl/");

# channel to use for getting dates
my %DATE_CH   = ( $LANG_FR => 'LA%20UNE',
		 $LANG_NL => 'TV1' );

my $SUMMARY_PATH = "zender.asp";
my $DETAIL_PATH = "detail.asp?progid=";

# populated from config file 
my @detailgenre;
my $detailstarttime;
my $detailstoptime;
my %get_channel_detail;
my $LANG;

#stats
my $numwebgets=0;
my $kbwebgets=0;
my $statstarttime=time();

# Check options.  First do the undocumented --cache option (to cache
# get(), which retrieves web pages), then the normal ones.
#
my $using_cache 
     = XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux'); 
my ($opt_days,
    $opt_help,
    $opt_output,
    $opt_input,
    $opt_share,
    $opt_slow,
    $opt_gui,
    $opt_configure,
    $opt_config_file,
    $opt_offset,
    $opt_quiet,
    $opt_list_channels,
   );
# No default for $opt_days, we determine it from the site.
$opt_offset = 0; # default today
$opt_quiet  = 0; # default
GetOptions('days=i'        => \$opt_days,
           'help'          => \$opt_help,
           'configure'     => \$opt_configure,
           'slow'          => \$opt_slow,
           'gui:s'         => \$opt_gui,
           'config-file=s' => \$opt_config_file,
           'output=s'      => \$opt_output,
           'offset=i'      => \$opt_offset,
	   'list-channels' => \$opt_list_channels,
           'quiet'         => \$opt_quiet,
           'input=s'       => \$opt_input, # undocumented -- debug mode: 
	                                   # read data from html file,
	                                   # no web page gets apart
	                                   # from program details

           'share=s'       => \$opt_share, # undocumented 
                                           # redefine share dir
          )
  or usage(0);
die 'number of days must not be negative'
  if (defined $opt_days && $opt_days < 0);
if ($opt_help) {
    usage(1);
}

# Date::Manip has a bug where 'now' will be wrong if you change the
# timezone.  It won't be correctly converted from the system timezone
# to the new one.  So we call parse_date('today midnight') _before_
# Date_Init().
#
my $today = DateCalc(parse_date('today midnight'), "$opt_offset days");
Date_Init('TZ=+0000');

# share/ directory for storing channel mapping files.  This next line
# is altered by processing through tv_grab_be.PL.  But we can use the
# current directory instead of share/tv_grab_be for development.
#
# The 'source' file tv_grab_be.in has $SHARE_DIR undef, which means
# use the current directory.  In any case the directory can be
# overridden with the --share option (useful for testing).
#
my $SHARE_DIR='/usr/share/xmltv'; # by grab/be/tv_grab_be.PL
$SHARE_DIR = $opt_share if defined $opt_share;
my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_be" : '.';
(my $CHANNEL_NAMES_FILE_BASE = "$OUR_SHARE_DIR/channel_ids_") =~ tr!/!/!s;

XMLTV::Ask::init($opt_gui);

# Tables to convert between telemoustique / teveblad and XMLTV ids of channels.
# The way to access these is through the routines be_to_xmltv() and
# xmltv_to_be(), not directly.  Those will deal sensibly with a new 
# channel that isn't mentioned in the file.
#
my (%be_to_xmltv, %xmltv_to_be, %extra_dn, %ch_warn, %logourl);
my $line_num = 0;

foreach my $CURLANG ( $LANG_FR, $LANG_NL ) {
    my $CHANNEL_NAMES_FILE = ( $CHANNEL_NAMES_FILE_BASE . $CURLANG );
    $line_num=0;
    foreach (XMLTV::Config_file::read_lines($CHANNEL_NAMES_FILE, 1)) {
        ++ $line_num;
        next unless defined;
        my $where = "$CHANNEL_NAMES_FILE:$line_num";
        my @fields = split(/:/,$_,5);
        die "$where: wrong number of fields: " . (scalar @fields)
            if @fields < 4 or @fields > 5;
        my ($xmltv_id, $be_id, $extra_dn, $logourl, $ch_warn) = @fields;
	die "$where Sanonma id not specified" 
	    if ( not defined $be_id || $be_id eq '' );
        warn "$where: $CURLANG Sanoma id $be_id seen already\n"
            if defined $be_to_xmltv{$CURLANG}{$be_id};
        $be_to_xmltv{$CURLANG}{$be_id} = $xmltv_id;
        warn "$where: $CURLANG XMLTV id $xmltv_id seen already\n"
            if defined $xmltv_to_be{$CURLANG}{$xmltv_id};
        $xmltv_to_be{$CURLANG}{$xmltv_id} = $be_id;
        $extra_dn{$CURLANG}{$xmltv_id} = $extra_dn 
	    if ( defined $extra_dn && $extra_dn ne '' );
        $logourl{$CURLANG}{$xmltv_id} = $logourl 
	    if ( defined $logourl && $logourl ne '' );
        $ch_warn{$CURLANG}{$xmltv_id} = $ch_warn 
	    if ( defined $ch_warn && $ch_warn ne '' );
    }
}
t 'xmltv_to_be: ' . d \%xmltv_to_be;
t 'be_to_xmltv: ' . d \%be_to_xmltv;
t 'extra_dn: ' . d \%extra_dn;
t 'ch_warn: ' . d \%ch_warn;

# Arguments for XMLTV::Writer.
my %g_args = ();
if (defined $opt_output) {
    die "cannot have both --output and --configure\n" if $opt_configure;
    my $fh = new IO::File ">$opt_output";
    die "cannot write to $opt_output\n" if not $fh;
    %g_args = (OUTPUT => $fh);
}

# Find the configuration file.  This grabber needs it even for listing
# channels since the channels available depend on the language.
#
my $config_file
  = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_be', $opt_quiet);

if ($opt_configure) {
    configure();
    exit;
}

# Not configuring - need to read an existing config file.
my @config_lines = XMLTV::Config_file::read_lines($config_file);

# Read the configuration file for language option
# language <F|D>
foreach (@config_lines) {
    ++ $line_num;
    next if not defined;
    my $where = "$config_file:$line_num";
    if (/^language\s+(.+)/) {
	if ( $1 eq $LANG_FR || $1 eq $LANG_NL) {
	    $LANG=$1;
	}
	else {
	    die "$where: invalid language defined in conf file\n";
	}
    }
}
die "language not defined in $config_file" if (not defined $LANG );

# Stuff at the top of any output XML.
my $metadata = { 'source-info-url'     => "$BASE_URL{$LANG}$SUMMARY_PATH",
		 'source-info-name'    => "$DOMAIN{$LANG}",
		 'generator-info-name' => 'XMLTV',
		 'generator-info-url'  =>
		 'http://membled.com/work/apps/xmltv/',
	       };

if ($opt_list_channels) {
    # Could check usage here to see --days etc. were not specified but
    # I can't be bothered.
    #
    my %channels = get_channels; # uses $LANG
    my $writer = new XMLTV::Writer(%g_args, encoding => 'ISO-8859-1');
    $writer->start($metadata);
    $writer->write_channels(\%channels);
    $writer->end;
}
else {
    if ($opt_input) {
	warn "grabbing from source HTML file: $opt_input for dummy channel ID la1.rtbf.be\n";
    }
    grab(\%g_args, \@config_lines);
}

printf (STDERR "Accessed %d web pages, downloaded %d Kb, duration %d secs\n",$numwebgets,$kbwebgets,time()-$statstarttime) unless $opt_quiet;
exit();

# Grab listings and write them in XML.  Parameters:
#
# ref to hash of arguments to be passed to XMLTV::Writer (but encoding
#   is always ISO-8859-1),
# ref to list of lines from config file.
#
sub grab( $$ ) {
    my ($w_args, $config_lines) = @_;
    my $writer = new XMLTV::Writer(%$w_args, encoding => 'ISO-8859-1');
    my %write_channels; # to be written as <channel> elements

    # FIXME turn into progress bar.
    print STDERR "finding channels:\t" unless $opt_quiet;

    my %channels;
    if ($opt_input) {
	# skip getting channels
        my @dns = ([ "La Une", $LANG ], [ "La Une"] );
        my $ch = { 'display-name' => \@dns,
                   'id' => "la1.rtbf.be"};
        t 'channel object: ' . d $ch;
        $channels{"la1.rtbf.be"} = $ch;
    }
    else {
	%channels = get_channels();
    }
    print STDERR "got " . (scalar keys %channels) . ", done.\n" unless $opt_quiet;

    # Read the configuration file.  At present the lines must be one
    # of the forms:
    #
    # channel <xmltv id> <fr:nl> [dodetail]
    # language <fr|nl>
    # detailgenere <regex>
    # detailstartime <hh:mm>
    # detailstoptime  <hh:mm>
    # ALL
    #
    my $line_num = 1;
    foreach (@$config_lines) {
        ++ $line_num;
        next if not defined;
        my $where = "$config_file:$line_num";
        if (/^channel\s+([^\s]+)\s+($LANG_FR|$LANG_NL)\s*([^\s]*)/) {
            my $xmltv_id = $1;
	    # $2 is grab language -- for future use when grabber
	    # can simultaneously grab both languages
	    die "$where: Specification of different Grab language currently not implemented"
		unless ( $2 eq $LANG);

            if (not defined $channels{$xmltv_id}) {
                warn "$where: no channel with XMLTV id $xmltv_id, skipping\n";
                next;
            }
            $write_channels{$xmltv_id} = $channels{$xmltv_id};
	    if ( $3 eq "dodetail" ) {
		$get_channel_detail{$xmltv_id} = 1;
	    }
        }
        elsif (/^language\s+(.+)/) {
            # already read -- ignore 
        }
        elsif (/^detailstarttime\s+([0-9]{2}:[0-9]{2})$/) {
            $detailstarttime=$1;
        }
        elsif (/^detailstoptime\s+([0-9]{2}:[0-9]{2})$/) {
	    $detailstoptime=$1;
	}
        elsif (/^detailgenre\s+(.+)/) {
	    # allow obsolete detailgeneres for ^$ and .*
	    if ( $1 eq ".*" ) { 
		warn "obsolete detailgenre \"$1\"in config file -- replace with *ALL*";
		push @detailgenre, "*ALL*";
	    } elsif ( $1 eq "^\$" ) {
		warn "obsolete detailgenre \"$1\" in config file -- replace with *NONE*";
		push @detailgenre, "*NONE*";
	    } else { 
		push @detailgenre, $1;
	    }
        }
        else { die "$where: bad line: \"$_\"\n" }
    }

    t "channels to get detail for: " . d \%get_channel_detail;
    t "detailstarttime=$detailstarttime" if ( $detailstarttime );
    t "detailstoptime=$detailstoptime" if ( $detailstoptime );
    t "genre(s) to get detail for: " . d \@detailgenre;

    if ( $opt_slow )
    {
 die <<END
You must reconfigure with --configure --slow to choose the programmes
to get details for.
END
   if not defined $detailstarttime or not defined $detailstoptime;
	
	# sanity check detail start time
	if ( ( $detailstoptime ge "24:00" ) 
	     || ( $detailstarttime ge "24:00" ) ) {
	    die "Invalid detail start/stop time range in $config_file: $detailstarttime - $detailstoptime";
	}
    }
    else
    {
	if ( $detailstoptime 
	     || $detailstoptime 
	     || @detailgenre 
	     || %get_channel_detail ) {
	    say ( <<END
WARNING: Config file contains settings for downloading detailed
programme information, but --slow has not been specified on command
line

No detailed programme information will be downloaded
END
		  ) ;
	}
    }

    # FIXME turn this into progress bar.
    print STDERR "getting dates for which listings available:\t"
      unless $opt_quiet;
    my @available_dates;
    if ($opt_input) {
	# skip getting dates
	@available_dates = ( $today );
    }
    else {
	@available_dates = get_available_dates();
    }
    t 'available dates: ' . d \@available_dates;
    die 'apparently, there are no days of listings on the site'
      if not @available_dates;
    print STDERR "got " . @available_dates .  ", done.\n" unless $opt_quiet;

    my $is_available = sub( $ ) {
        my $d = shift;
        foreach (@available_dates) {
            return 1 if not Date_Cmp($d, $_);
        }
        return 0;
    };

    my @dates_to_get;
    for (my $d = $todayiption text;
Added parsing of movie ratings (classifications); Future-proof config
file to cope with grabbing multiple languages simultaneously; Added
--output option

B<2004-01-15 nielm> - Put year into date tag; Put director of films
(if found in descr) into director tag; Get year from descr if not
found, add channel logos (from satlogo.com).

B<2004-01-26 nielm> - handle VO/OV image without warning; make
multi-line descriptions; correct date parsing; correct episode num 
in FR listings; correct stop time bug when no stop time defined; 
removed lang=xx from title and sub-title; 

B<2004-01-29 nielm> - add icons in rating and star-rating; handle
episode numbers in titles better; handle extracting of director
better.

B<2004-02-23 nielm/epaepa> - tidy up of help text, remove newlines
from desc, improve start/stop time details matching, add detaul URL to
fast mode programme info

B<2004-03-04 nielm> - Correct usage, handle Duree (length), handle
repeats (previously-shown), handle episode numbers in description. 
More things added to TODO list (see source code)

B<2004-03-09 nielm> - Remove Duree and (R.) from description
text. Remove categories in description. Do not put episode numbers in
sub-title

B<2004-04-01 nielm> - Fixed bug with no stop time for programs
starting at midnight, handle 'New' icon, Fixed JIMTV channel ID,
handle 'Divers' tags (which may contain info on previously-shown),
remove 'gastacteurs:' from actor names.

B<2004-04-05 epaepa/nielm> - Make time zones consistantly +0100 or
+0200, but never mixed. Clean up punctuation around actor
names. Remove duplicate ChannelID from file (only put alternative
ID's). better actor parsing

B<2004-04-05 epaepa/nielm> - Handle user input better during config
(CTRL-D, CTRL-H), use substrings not regexps for category/channel
matching to avoid nastyness when a user enters a bad regexp. Add magic
category *NONE* and *ALL* for category matching.

B<2004-04-15 nielm> - yet more cleanup in parsing actor names, ignore
programmes with no titles.

B<2005-03-12 nielm> - no function changes: just changes to the
configuration section to use XMLTV::ask, and updates to the
channel_ids files

B<2005-09-22 nielm> - www.telemoustique.be no longer works: quick
and dirty fix: use www.telepocket.be instead.

=cut

# TODO
#
# Merge fr and nl configs to allow single config file.
#
#
# Handle listings where a program is shown again later in the day
# without a separate lsting for it: eg:
#    <desc lang="fr">les moments les plus delirants de
#    l'emission. (13.30, 16.15, 20.45, 0.30)</desc>
#    <desc lang="fr">Srie anime. La dcision de Petit-Coeur 
#    (R.  17.30 et 24.00)</desc>
#    <desc lang="fr">Srie australienne (R.  18.00)</desc>
# implies this program will be shown at these later times... 
# 
#
# Handle Followed by 'Suivi' in Fremch descriptions
#   <desc lang="fr">(R.) Suivi de Le Shopping.</desc>
#   <desc lang="fr">Suivi,  14.40, de Tranche de rire.</desc>
#   <desc lang="fr">suivi  14.10 de La Boutique - 14.40 Tranche de rire.</desc>
#   <desc lang="fr">Srie quotidienne franaise suivie,  19.55, de la Mto.</desc>
#   <desc lang="fr">suivi de L'invit - La mto</desc>
#   <desc lang="fr">suivi de L'invit - La mto. Pascal Vrebos reoit Laurette Onkelinx, Ministre de la Justice (PS).</desc>
#
# Handle grouped programmes
#     <desc lang="fr">Le lutin Plop
#      - 7.00 La cour de rcr (R.) 
#      - 7.25 Pepper Ann (R.) 
#      - 7.50 Jim Bouton.</desc>
#


use strict;
use XMLTV::Version '$Id: tv_grab_be.in,v 1.8 2006/04/12 16:59:52 mattiasholmlund Exp $ ';
use XMLTV::Capabilities qw/baseline manualconfig cache share/;
use XMLTV::Description 'Belgium';
use IO::Socket;
use LWP::Simple;
use Date::Manip;
use Getopt::Long;
use HTML::Entities;
use XMLTV;
use XMLTV::Memoize;
use XMLTV::Ask;
use XMLTV::ProgressBar;
use XMLTV::DST;
use XMLTV::Config_file;
use XMLTV::Get_nice; 
use XMLTV::Date qw(parse_date); 
use XMLTV::Usage <<END
To configure:     $0 --configure [--config-file FILE] [--slow] [--gui OPTION]
To grab listings: $0 [--config-file FILE] [--output FILE] 
                     [--days N] [--offset N] [--quiet] [--slow] [--gui OPTION]
To list channels: $0 [--output FILE] [--quiet] [--config-file FILE] --list-channels
To show capabilities: $0 --capabilities
To show version: $0 --version
END
  ;

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

sub get_url( $ );
sub get_programmes( $$$$$$ );
sub get_programme_summary( $$$$ );
sub get_programme_detailed_info($$);
sub parse_programme_details($$); # ref of prog hash, array of descr strings
sub get_channels();
sub get_categories();
sub get_available_dates();
sub be_to_xmltv( $ );
sub xmltv_to_be( $ );
sub grab( $$ );
sub configure();

# GLOBAL CONSTANTS
my $LANG_FR = 'fr';
my $LANG_NL = 'nl';

# language-dependant constants
my %DOMAIN = ( $LANG_FR => 'telepocket.be',
		 $LANG_NL => 'teveblad.be' );
my %BASE_URL = ( $LANG_FR => "http://www.$DOMAIN{$LANG_FR}/fr/",
		 $LANG_NL => "http://www.$DOMAIN{$LANG_NL}/ndl/");

# channel to use for getting dates
my %DATE_CH   = ( $LANG_FR => 'LA%20UNE',
		 $LANG_NL => 'TV1' );

my $SUMMARY_PATH = "zender.asp";
my $DETAIL_PATH = "detail.asp?progid=";

# populated from config file 
my @detailgenre;
my $detailstarttime;
my $detailstoptime;
my %get_channel_detail;
my $LANG;

#stats
my $numwebgets=0;
my $kbwebgets=0;
my $statstarttime=time();

# Check options.  First do the undocumented --cache option (to cache
# get(), which retrieves web pages), then the normal ones.
#
my $using_cache 
     = XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux'); 
my ($opt_days,
    $opt_help,
    $opt_output,
    $opt_input,
    $opt_share,
    $opt_slow,
    $opt_gui,
    $opt_configure,
    $opt_config_file,
    $opt_offset,
    $opt_quiet,
    $opt_list_channels,
   );
# No default for $opt_days, we determine it from the site.
$opt_offset = 0; # default today
$opt_quiet  = 0; # default
GetOptions('days=i'        => \$opt_days,
           'help'          => \$opt_help,
           'configure'     => \$opt_configure,
           'slow'          => \$opt_slow,
           'gui:s'         => \$opt_gui,
           'config-file=s' => \$opt_config_file,
           'output=s'      => \$opt_output,
           'offset=i'      => \$opt_offset,
	   'list-channels' => \$opt_list_channels,
           'quiet'         => \$opt_quiet,
           'input=s'       => \$opt_input, # undocumented -- debug mode: 
	                                   # read data from html file,
	                                   # no web page gets apart
	                                   # from program details

           'share=s'       => \$opt_share, # undocumented 
                                           # redefine share dir
          )
  or usage(0);
die 'number of days must not be negative'
  if (defined $opt_days && $opt_days < 0);
if ($opt_help) {
    usage(1);
}

# Date::Manip has a bug where 'now' will be wrong if you change the
# timezone.  It won't be correctly converted from the system timezone
# to the new one.  So we call parse_date('today midnight') _before_
# Date_Init().
#
my $today = DateCalc(parse_date('today midnight'), "$opt_offset days");
Date_Init('TZ=+0000');

# share/ directory for storing channel mapping files.  This next line
# is altered by processing through tv_grab_be.PL.  But we can use the
# current directory instead of share/tv_grab_be for development.
#
# The 'source' file tv_grab_be.in has $SHARE_DIR undef, which means
# use the current directory.  In any case the directory can be
# overridden with the --share option (useful for testing).
#
my $SHARE_DIR='/usr/share/xmltv'; # by grab/be/tv_grab_be.PL
$SHARE_DIR = $opt_share if defined $opt_share;
my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_be" : '.';
(my $CHANNEL_NAMES_FILE_BASE = "$OUR_SHARE_DIR/channel_ids_") =~ tr!/!/!s;

XMLTV::Ask::init($opt_gui);

# Tables to convert between telemoustique / teveblad and XMLTV ids of channels.
# The way to access these is through the routines be_to_xmltv() and
# xmltv_to_be(), not directly.  Those will deal sensibly with a new 
# channel that isn't mentioned in the file.
#
my (%be_to_xmltv, %xmltv_to_be, %extra_dn, %ch_warn, %logourl);
my $line_num = 0;

foreach my $CURLANG ( $LANG_FR, $LANG_NL ) {
    my $CHANNEL_NAMES_FILE = ( $CHANNEL_NAMES_FILE_BASE . $CURLANG );
    $line_num=0;
    foreach (XMLTV::Config_file::read_lines($CHANNEL_NAMES_FILE, 1)) {
        ++ $line_num;
        next unless defined;
        my $where = "$CHANNEL_NAMES_FILE:$line_num";
        my @fields = split(/:/,$_,5);
        die "$where: wrong number of fields: " . (scalar @fields)
            if @fields < 4 or @fields > 5;
        my ($xmltv_id, $be_id, $extra_dn, $logourl, $ch_warn) = @fields;
	die "$where Sanonma id not specified" 
	    if ( not defined $be_id || $be_id eq '' );
        warn "$where: $CURLANG Sanoma id $be_id seen already\n"
            if defined $be_to_xmltv{$CURLANG}{$be_id};
        $be_to_xmltv{$CURLANG}{$be_id} = $xmltv_id;
        warn "$where: $CURLANG XMLTV id $xmltv_id seen already\n"
            if defined $xmltv_to_be{$CURLANG}{$xmltv_id};
        $xmltv_to_be{$CURLANG}{$xmltv_id} = $be_id;
        $extra_dn{$CURLANG}{$xmltv_id} = $extra_dn 
	    if ( defined $extra_dn && $extra_dn ne '' );
        $logourl{$CURLANG}{$xmltv_id} = $logourl 
	    if ( defined $logourl && $logourl ne '' );
        $ch_warn{$CURLANG}{$xmltv_id} = $ch_warn 
	    if ( defined $ch_warn && $ch_warn ne '' );
    }
}
t 'xmltv_to_be: ' . d \%xmltv_to_be;
t 'be_to_xmltv: ' . d \%be_to_xmltv;
t 'extra_dn: ' . d \%extra_dn;
t 'ch_warn: ' . d \%ch_warn;

# Arguments for XMLTV::Writer.
my %g_args = ();
if (defined $opt_output) {
    die "cannot have both --output and --configure\n" if $opt_configure;
    my $fh = new IO::File ">$opt_output";
    die "cannot write to $opt_output\n" if not $fh;
    %g_args = (OUTPUT => $fh);
}

# Find the configuration file.  This grabber needs it even for listing
# channels since the channels available depend on the language.
#
my $config_file
  = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_be', $opt_quiet);

if ($opt_configure) {
    configure();
    exit;
}

# Not configuring - need to read an existing config file.
my @config_lines = XMLTV::Config_file::read_lines($config_file);

# Read the configuration file for language option
# language <F|D>
foreach (@config_lines) {
    ++ $line_num;
    next if not defined;
    my $where = "$config_file:$line_num";
    if (/^language\s+(.+)/) {
	if ( $1 eq $LANG_FR || $1 eq $LANG_NL) {
	    $LANG=$1;
	}
	else {
	    die "$where: invalid language defined in conf file\n";
	}
    }
}
die "language not defined in $config_file" if (not defined $LANG );

# Stuff at the top of any output XML.
my $metadata = { 'source-info-url'     => "$BASE_URL{$LANG}$SUMMARY_PATH",
		 'source-info-name'    => "$DOMAIN{$LANG}",
		 'generator-info-name' => 'XMLTV',
		 'generator-info-url'  =>
		 'http://membled.com/work/apps/xmltv/',
	       };

if ($opt_list_channels) {
    # Could check usage here to see --days etc. were not specified but
    # I can't be bothered.
    #
    my %channels = get_channels; # uses $LANG
    my $writer = new XMLTV::Writer(%g_args, encoding => 'ISO-8859-1');
    $writer->start($metadata);
    $writer->write_channels(\%channels);
    $writer->end;
}
else {
    if ($opt_input) {
	warn "grabbing from source HTML file: $opt_input for dummy channel ID la1.rtbf.be\n";
    }
    grab(\%g_args, \@config_lines);
}

printf (STDERR "Accessed %d web pages, downloaded %d Kb, duration %d secs\n",$numwebgets,$kbwebgets,time()-$statstarttime) unless $opt_quiet;
exit();

# Grab listings and write them in XML.  Parameters:
#
# ref to hash of arguments to be passed to XMLTV::Writer (but encoding
#   is always ISO-8859-1),
# ref to list of lines from config file.
#
sub grab( $$ ) {
    my ($w_args, $config_lines) = @_;
    my $writer = new XMLTV::Writer(%$w_args, encoding => 'ISO-8859-1');
    my %write_channels; # to be written as <channel> elements

    # FIXME turn into progress bar.
    print STDERR "finding channels:\t" unless $opt_quiet;

    my %channels;
    if ($opt_input) {
	# skip getting channels
        my @dns = ([ "La Une", $LANG ], [ "La Une"] );
        my $ch = { 'display-name' => \@dns,
                   'id' => "la1.rtbf.be"};
        t 'channel object: ' . d $ch;
        $channels{"la1.rtbf.be"} = $ch;
    }
    else {
	%channels = get_channels();
    }
    print STDERR "got " . (scalar keys %channels) . ", done.\n" unless $opt_quiet;

    # Read the configuration file.  At present the lines must be one
    # of the forms:
    #
    # channel <xmltv id> <fr:nl> [dodetail]
    # language <fr|nl>
    # detailgenere <regex>
    # detailstartime <hh:mm>
    # detailstoptime  <hh:mm>
    # ALL
    #
    my $line_num = 1;
    foreach (@$config_lines) {
        ++ $line_num;
        next if not defined;
        my $where = "$config_file:$line_num";
        if (/^channel\s+([^\s]+)\s+($LANG_FR|$LANG_NL)\s*([^\s]*)/) {
            my $xmltv_id = $1;
	    # $2 is grab language -- for future use when grabber
	    # can simultaneously grab both languages
	    die "$where: Specification of different Grab language currently not implemented"
		unless ( $2 eq $LANG);

            if (not defined $channels{$xmltv_id}) {
                warn "$where: no channel with XMLTV id $xmltv_id, skipping\n";
                next;
            }
            $write_channels{$xmltv_id} = $channels{$xmltv_id};
	    if ( $3 eq "dodetail" ) {
		$get_channel_detail{$xmltv_id} = 1;
	    }
        }
        elsif (/^language\s+(.+)/) {
            # already read -- ignore 
        }
        elsif (/^detailstarttime\s+([0-9]{2}:[0-9]{2})$/) {
            $detailstarttime=$1;
        }
        elsif (/^detailstoptime\s+([0-9]{2}:[0-9]{2})$/) {
	    $detailstoptime=$1;
	}
        elsif (/^detailgenre\s+(.+)/) {
	    # allow obsolete detailgeneres for ^$ and .*
	    if ( $1 eq ".*" ) { 
		warn "obsolete detailgenre \"$1\"in config file -- replace with *ALL*";
		push @detailgenre, "*ALL*";
	    } elsif ( $1 eq "^\$" ) {
		warn "obsolete detailgenre \"$1\" in config file -- replace with *NONE*";
		push @detailgenre, "*NONE*";
	    } else { 
		push @detailgenre, $1;
	    }
        }
        else { die "$where: bad line: \"$_\"\n" }
    }

    t "channels to get detail for: " . d \%get_channel_detail;
    t "detailstarttime=$detailstarttime" if ( $detailstarttime );
    t "detailstoptime=$detailstoptime" if ( $detailstoptime );
    t "genre(s) to get detail for: " . d \@detailgenre;

    if ( $opt_slow )
    {
 die <<END
You must reconfigure with --configure --slow to choose the programmes
to get details for.
END
   if not defined $detailstarttime or not defined $detailstoptime;
	
	# sanity check detail start time
	if ( ( $detailstoptime ge "24:00" ) 
	     || ( $detailstarttime ge "24:00" ) ) {
	    die "Invalid detail start/stop time range in $config_file: $detailstarttime - $detailstoptime";
	}
    }
    else
    {
	if ( $detailstoptime 
	     || $detailstoptime 
	     || @detailgenre 
	     || %get_channel_detail ) {
	    say ( <<END
WARNING: Config file contains settings for downloading detailed
programme information, but --slow has not been specified on command
line

No detailed programme information will be downloaded
END
		  ) ;
	}
    }

    # FIXME turn this into progress bar.
    print STDERR "getting dates for which listings available:\t"
      unless $opt_quiet;
    my @available_dates;
    if ($opt_input) {
	# skip getting dates
	@available_dates = ( $today );
    }
    else {
	@available_dates = get_available_dates();
    }
    t 'available dates: ' . d \@available_dates;
    die 'apparently, there are no days of listings on the site'
      if not @available_dates;
    print STDERR "got " . @available_dates .  ", done.\n" unless $opt_quiet;

    my $is_available = sub( $ ) {
        my $d = shift;
        foreach (@available_dates) {
            return 1 if not Date_Cmp($d, $_);
        }
        return 0;
    };

    my @dates_to_get;
    for (my $d = $todayiption text;
Added parsing of movie ratings (classifications); Future-proof config
file to cope with grabbing multiple languages simultaneously; Added
--output option

B<2004-01-15 nielm> - Put year into date tag; Put director of films
(if found in descr) into director tag; Get year from descr if not
found, add channel logos (from satlogo.com).

B<2004-01-26 nielm> - handle VO/OV image without warning; make
multi-line descriptions; correct date parsing; correct episode num 
in FR listings; correct stop time bug when no stop time defined; 
removed lang=xx from title and sub-title; 

B<2004-01-29 nielm> - add icons in rating and star-rating; handle
episode numbers in titles better; handle extracting of director
better.

B<2004-02-23 nielm/epaepa> - tidy up of help text, remove newlines
from desc, improve start/stop time details matching, add detaul URL to
fast mode programme info

B<2004-03-04 nielm> - Correct usage, handle Duree (length), handle
repeats (previously-shown), handle episode numbers in description. 
More things added to TODO list (see source code)

B<2004-03-09 nielm> - Remove Duree and (R.) from description
text. Remove categories in description. Do not put episode numbers in
sub-title

B<2004-04-01 nielm> - Fixed bug with no stop time for programs
starting at midnight, handle 'New' icon, Fixed JIMTV channel ID,
handle 'Divers' tags (which may contain info on previously-shown),
remove 'gastacteurs:' from actor names.

B<2004-04-05 epaepa/nielm> - Make time zones consistantly +0100 or
+0200, but never mixed. Clean up punctuation around actor
names. Remove duplicate ChannelID from file (only put alternative
ID's). better actor parsing

B<2004-04-05 epaepa/nielm> - Handle user input better during config
(CTRL-D, CTRL-H), use substrings not regexps for category/channel
matching to avoid nastyness when a user enters a bad regexp. Add magic
category *NONE* and *ALL* for category matching.

B<2004-04-15 nielm> - yet more cleanup in parsing actor names, ignore
programmes with no titles.

B<2005-03-12 nielm> - no function changes: just changes to the
configuration section to use XMLTV::ask, and updates to the
channel_ids files

B<2005-09-22 nielm> - www.telemoustique.be no longer works: quick
and dirty fix: use www.telepocket.be instead.

=cut

# TODO
#
# Merge fr and nl configs to allow single config file.
#
#
# Handle listings where a program is shown again later in the day
# without a separate lsting for it: eg:
#    <desc lang="fr">les moments les plus delirants de
#    l'emission. (13.30, 16.15, 20.45, 0.30)</desc>
#    <desc lang="fr">Srie anime. La dcision de Petit-Coeur 
#    (R.  17.30 et 24.00)</desc>
#    <desc lang="fr">Srie australienne (R.  18.00)</desc>
# implies this program will be shown at these later times... 
# 
#
# Handle Followed by 'Suivi' in Fremch descriptions
#   <desc lang="fr">(R.) Suivi de Le Shopping.</desc>
#   <desc lang="fr">Suivi,  14.40, de Tranche de rire.</desc>
#   <desc lang="fr">suivi  14.10 de La Boutique - 14.40 Tranche de rire.</desc>
#   <desc lang="fr">Srie quotidienne franaise suivie,  19.55, de la Mto.</desc>
#   <desc lang="fr">suivi de L'invit - La mto</desc>
#   <desc lang="fr">suivi de L'invit - La mto. Pascal Vrebos reoit Laurette Onkelinx, Ministre de la Justice (PS).</desc>
#
# Handle grouped programmes
#     <desc lang="fr">Le lutin Plop
#      - 7.00 La cour de rcr (R.) 
#      - 7.25 Pepper Ann (R.) 
#      - 7.50 Jim Bouton.</desc>
#


use strict;
use XMLTV::Version '$Id: tv_grab_be.in,v 1.8 2006/04/12 16:59:52 mattiasholmlund Exp $ ';
use XMLTV::Capabilities qw/baseline manualconfig cache share/;
use XMLTV::Description 'Belgium';
use IO::Socket;
use LWP::Simple;
use Date::Manip;
use Getopt::Long;
use HTML::Entities;
use XMLTV;
use XMLTV::Memoize;
use XMLTV::Ask;
use XMLTV::ProgressBar;
use XMLTV::DST;
use XMLTV::Config_file;
use XMLTV::Get_nice; 
use XMLTV::Date qw(parse_date); 
use XMLTV::Usage <<END
To configure:     $0 --configure [--config-file FILE] [--slow] [--gui OPTION]
To grab listings: $0 [--config-file FILE] [--output FILE] 
                     [--days N] [--offset N] [--quiet] [--slow] [--gui OPTION]
To list channels: $0 [--output FILE] [--quiet] [--config-file FILE] --list-channels
To show capabilities: $0 --capabilities
To show version: $0 --version
END
  ;

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

sub get_url( $ );
sub get_programmes( $$$$$$ );
sub get_programme_summary( $$$$ );
sub get_programme_detailed_info($$);
sub parse_programme_details($$); # ref of prog hash, array of descr strings
sub get_channels();
sub get_categories();
sub get_available_dates();
sub be_to_xmltv( $ );
sub xmltv_to_be( $ );
sub grab( $$ );
sub configure();

# GLOBAL CONSTANTS
my $LANG_FR = 'fr';
my $LANG_NL = 'nl';

# language-dependant constants
my %DOMAIN = ( $LANG_FR => 'telepocket.be',
		 $LANG_NL => 'teveblad.be' );
my %BASE_URL = ( $LANG_FR => "http://www.$DOMAIN{$LANG_FR}/fr/",
		 $LANG_NL => "http://www.$DOMAIN{$LANG_NL}/ndl/");

# channel to use for getting dates
my %DATE_CH   = ( $LANG_FR => 'LA%20UNE',
		 $LANG_NL => 'TV1' );

my $SUMMARY_PATH = "zender.asp";
my $DETAIL_PATH = "detail.asp?progid=";

# populated from config file 
my @detailgenre;
my $detailstarttime;
my $detailstoptime;
my %get_channel_detail;
my $LANG;

#stats
my $numwebgets=0;
my $kbwebgets=0;
my $statstarttime=time();

# Check options.  First do the undocumented --cache option (to cache
# get(), which retrieves web pages), then the normal ones.
#
my $using_cache 
     = XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux'); 
my ($opt_days,
    $opt_help,
    $opt_output,
    $opt_input,
    $opt_share,
    $opt_slow,
    $opt_gui,
    $opt_configure,
    $opt_config_file,
    $opt_offset,
    $opt_quiet,
    $opt_list_channels,
   );
# No default for $opt_days, we determine it from the site.
$opt_offset = 0; # default today
$opt_quiet  = 0; # default
GetOptions('days=i'        => \$opt_days,
           'help'          => \$opt_help,
           'configure'     => \$opt_configure,
           'slow'          => \$opt_slow,
           'gui:s'         => \$opt_gui,
           'config-file=s' => \$opt_config_file,
           'output=s'      => \$opt_output,
           'offset=i'      => \$opt_offset,
	   'list-channels' => \$opt_list_channels,
           'quiet'         => \$opt_quiet,
           'input=s'       => \$opt_input, # undocumented -- debug mode: 
	                                   # read data from html file,
	                                   # no web page gets apart
	                                   # from program details

           'share=s'       => \$opt_share, # undocumented 
                                           # redefine share dir
          )
  or usage(0);
die 'number of days must not be negative'
  if (defined $opt_days && $opt_days < 0);
if ($opt_help) {
    usage(1);
}

# Date::Manip has a bug where 'now' will be wrong if you change the
# timezone.  It won't be correctly converted from the system timezone
# to the new one.  So we call parse_date('today midnight') _before_
# Date_Init().
#
my $today = DateCalc(parse_date('today midnight'), "$opt_offset days");
Date_Init('TZ=+0000');

# share/ directory for storing channel mapping files.  This next line
# is altered by processing through tv_grab_be.PL.  But we can use the
# current directory instead of share/tv_grab_be for development.
#
# The 'source' file tv_grab_be.in has $SHARE_DIR undef, which means
# use the current directory.  In any case the directory can be
# overridden with the --share option (useful for testing).
#
my $SHARE_DIR='/usr/share/xmltv'; # by grab/be/tv_grab_be.PL
$SHARE_DIR = $opt_share if defined $opt_share;
my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_be" : '.';
(my $CHANNEL_NAMES_FILE_BASE = "$OUR_SHARE_DIR/channel_ids_") =~ tr!/!/!s;

XMLTV::Ask::init($opt_gui);

# Tables to convert between telemoustique / teveblad and XMLTV ids of channels.
# The way to access these is through the routines be_to_xmltv() and
# xmltv_to_be(), not directly.  Those will deal sensibly with a new 
# channel that isn't mentioned in the file.
#
my (%be_to_xmltv, %xmltv_to_be, %extra_dn, %ch_warn, %logourl);
my $line_num = 0;

foreach my $CURLANG ( $LANG_FR, $LANG_NL ) {
    my $CHANNEL_NAMES_FILE = ( $CHANNEL_NAMES_FILE_BASE . $CURLANG );
    $line_num=0;
    foreach (XMLTV::Config_file::read_lines($CHANNEL_NAMES_FILE, 1)) {
        ++ $line_num;
        next unless defined;
        my $where = "$CHANNEL_NAMES_FILE:$line_num";
        my @fields = split(/:/,$_,5);
        die "$where: wrong number of fields: " . (scalar @fields)
            if @fields < 4 or @fields > 5;
        my ($xmltv_id, $be_id, $extra_dn, $logourl, $ch_warn) = @fields;
	die "$where Sanonma id not specified" 
	    if ( not defined $be_id || $be_id eq '' );
        warn "$where: $CURLANG Sanoma id $be_id seen already\n"
            if defined $be_to_xmltv{$CURLANG}{$be_id};
        $be_to_xmltv{$CURLANG}{$be_id} = $xmltv_id;
        warn "$where: $CURLANG XMLTV id $xmltv_id seen already\n"
            if defined $xmltv_to_be{$CURLANG}{$xmltv_id};
        $xmltv_to_be{$CURLANG}{$xmltv_id} = $be_id;
        $extra_dn{$CURLANG}{$xmltv_id} = $extra_dn 
	    if ( defined $extra_dn && $extra_dn ne '' );
        $logourl{$CURLANG}{$xmltv_id} = $logourl 
	    if ( defined $logourl && $logourl ne '' );
        $ch_warn{$CURLANG}{$xmltv_id} = $ch_warn 
	    if ( defined $ch_warn && $ch_warn ne '' );
    }
}
t 'xmltv_to_be: ' . d \%xmltv_to_be;
t 'be_to_xmltv: ' . d \%be_to_xmltv;
t 'extra_dn: ' . d \%extra_dn;
t 'ch_warn: ' . d \%ch_warn;

# Arguments for XMLTV::Writer.
my %g_args = ();
if (defined $opt_output) {
    die "cannot have both --output and --configure\n" if $opt_configure;
    my $fh = new IO::File ">$opt_output";
    die "cannot write to $opt_output\n" if not $fh;
    %g_args = (OUTPUT => $fh);
}

# Find the configuration file.  This grabber needs it even for listing
# channels since the channels available depend on the language.
#
my $config_file
  = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_be', $opt_quiet);

if ($opt_configure) {
    configure();
    exit;
}

# Not configuring - need to read an existing config file.
my @config_lines = XMLTV::Config_file::read_lines($config_file);

# Read the configuration file for language option
# language <F|D>
foreach (@config_lines) {
    ++ $line_num;
    next if not defined;
    my $where = "$config_file:$line_num";
    if (/^language\s+(.+)/) {
	if ( $1 eq $LANG_FR || $1 eq $LANG_NL) {
	    $LANG=$1;
	}
	else {
	    die "$where: invalid language defined in conf file\n";
	}
    }
}
die "language not defined in $config_file" if (not defined $LANG );

# Stuff at the top of any output XML.
my $metadata = { 'source-info-url'     => "$BASE_URL{$LANG}$SUMMARY_PATH",
		 'source-info-name'    => "$DOMAIN{$LANG}",
		 'generator-info-name' => 'XMLTV',
		 'generator-info-url'  =>
		 'http://membled.com/work/apps/xmltv/',
	       };

if ($opt_list_channels) {
    # Could check usage here to see --days etc. were not specified but
    # I can't be bothered.
    #
    my %channels = get_channels; # uses $LANG
    my $writer = new XMLTV::Writer(%g_args, encoding => 'ISO-8859-1');
    $writer->start($metadata);
    $writer->write_channels(\%channels);
    $writer->end;
}
else {
    if ($opt_input) {
	warn "grabbing from source HTML file: $opt_input for dummy channel ID la1.rtbf.be\n";
    }
    grab(\%g_args, \@config_lines);
}

printf (STDERR "Accessed %d web pages, downloaded %d Kb, duration %d secs\n",$numwebgets,$kbwebgets,time()-$statstarttime) unless $opt_quiet;
exit();

# Grab listings and write them in XML.  Parameters:
#
# ref to hash of arguments to be passed to XMLTV::Writer (but encoding
#   is always ISO-8859-1),
# ref to list of lines from config file.
#
sub grab( $$ ) {
    my ($w_args, $config_lines) = @_;
    my $writer = new XMLTV::Writer(%$w_args, encoding => 'ISO-8859-1');
    my %write_channels; # to be written as <channel> elements

    # FIXME turn into progress bar.
    print STDERR "finding channels:\t" unless $opt_quiet;

    my %channels;
    if ($opt_input) {
	# skip getting channels
        my @dns = ([ "La Une", $LANG ], [ "La Une"] );
        my $ch = { 'display-name' => \@dns,
                   'id' => "la1.rtbf.be"};
        t 'channel object: ' . d $ch;
        $channels{"la1.rtbf.be"} = $ch;
    }
    else {
	%channels = get_channels();
    }
    print STDERR "got " . (scalar keys %channels) . ", done.\n" unless $opt_quiet;

    # Read the configuration file.  At present the lines must be one
    # of the forms:
    #
    # channel <xmltv id> <fr:nl> [dodetail]
    # language <fr|nl>
    # detailgenere <regex>
    # detailstartime <hh:mm>
    # detailstoptime  <hh:mm>
    # ALL
    #
    my $line_num = 1;
    foreach (@$config_lines) {
        ++ $line_num;
        next if not defined;
        my $where = "$config_file:$line_num";
        if (/^channel\s+([^\s]+)\s+($LANG_FR|$LANG_NL)\s*([^\s]*)/) {
            my $xmltv_id = $1;
	    # $2 is grab language -- for future use when grabber
	    # can simultaneously grab both languages
	    die "$where: Specification of different Grab language currently not implemented"
		unless ( $2 eq $LANG);

            if (not defined $channels{$xmltv_id}) {
                warn "$where: no channel with XMLTV id $xmltv_id, skipping\n";
                next;
            }
            $write_channels{$xmltv_id} = $channels{$xmltv_id};
	    if ( $3 eq "dodetail" ) {
		$get_channel_detail{$xmltv_id} = 1;
	    }
        }
        elsif (/^language\s+(.+)/) {
            # already read -- ignore 
        }
        elsif (/^detailstarttime\s+([0-9]{2}:[0-9]{2})$/) {
            $detailstarttime=$1;
        }
        elsif (/^detailstoptime\s+([0-9]{2}:[0-9]{2})$/) {
	    $detailstoptime=$1;
	}
        elsif (/^detailgenre\s+(.+)/) {
	    # allow obsolete detailgeneres for ^$ and .*
	    if ( $1 eq ".*" ) { 
		warn "obsolete detailgenre \"$1\"in config file -- replace with *ALL*";
		push @detailgenre, "*ALL*";
	    } elsif ( $1 eq "^\$" ) {
		warn "obsolete detailgenre \"$1\" in config file -- replace with *NONE*";
		push @detailgenre, "*NONE*";
	    } else { 
		push @detailgenre, $1;
	    }
        }
        else { die "$where: bad line: \"$_\"\n" }
    }

    t "channels to get detail for: " . d \%get_channel_detail;
    t "detailstarttime=$detailstarttime" if ( $detailstarttime );
    t "detailstoptime=$detailstoptime" if ( $detailstoptime );
    t "genre(s) to get detail for: " . d \@detailgenre;

    if ( $opt_slow )
    {
 die <<END
You must reconfigure with --configure --slow to choose the programmes
to get details for.
END
   if not defined $detailstarttime or not defined $detailstoptime;
	
	# sanity check detail start time
	if ( ( $detailstoptime ge "24:00" ) 
	     || ( $detailstarttime ge "24:00" ) ) {
	    die "Invalid detail start/stop time range in $config_file: $detailstarttime - $detailstoptime";
	}
    }
    else
    {
	if ( $detailstoptime 
	     || $detailstoptime 
	     || @detailgenre 
	     || %get_channel_detail ) {
	    say ( <<END
WARNING: Config file contains settings for downloading detailed
programme information, but --slow has not been specified on command
line

No detailed programme information will be downloaded
END
		  ) ;
	}
    }

    # FIXME turn this into progress bar.
    print STDERR "getting dates for which listings available:\t"
      unless $opt_quiet;
    my @available_dates;
    if ($opt_input) {
	# skip getting dates
	@available_dates = ( $today );
    }
    else {
	@available_dates = get_available_dates();
    }
    t 'available dates: ' . d \@available_dates;
    die 'apparently, there are no days of listings on the site'
      if not @available_dates;
    print STDERR "got " . @available_dates .  ", done.\n" unless $opt_quiet;

    my $is_available = sub( $ ) {
        my $d = shift;
        foreach (@available_dates) {
            return 1 if not Date_Cmp($d, $_);
        }
        return 0;
    };

    my @dates_to_get;
    for (my $d = $todayiption text;
Added parsing of movie ratings (classifications); Future-proof config
file to cope with grabbing multiple languages simultaneously; Added
--output option

B<2004-01-15 nielm> - Put year into date tag; Put director of films
(if found in descr) into director tag; Get year from descr if not
found, add channel logos (from satlogo.com).

B<2004-01-26 nielm> - handle VO/OV image without warning; make
multi-line descriptions; correct date parsing; correct episode num 
in FR listings; correct stop time bug when no stop time defined; 
removed lang=xx from title and sub-title; 

B<2004-01-29 nielm> - add icons in rating and star-rating; handle
episode numbers in titles better; handle extracting of director
better.

B<2004-02-23 nielm/epaepa> - tidy up of help text, remove newlines
from desc, improve start/stop time details matching, add detaul URL to
fast mode programme info

B<2004-03-04 nielm> - Correct usage, handle Duree (length), handle
repeats (previously-shown), handle episode numbers in description. 
More things added to TODO list (see source code)

B<2004-03-09 nielm> - Remove Duree and (R.) from description
text. Remove categories in description. Do not put episode numbers in
sub-title

B<2004-04-01 nielm> - Fixed bug with no stop time for programs
starting at midnight, handle 'New' icon, Fixed JIMTV channel ID,
handle 'Divers' tags (which may contain info on previously-shown),
remove 'gastacteurs:' from actor names.

B<2004-04-05 epaepa/nielm> - Make time zones consistantly +0100 or
+0200, but never mixed. Clean up punctuation around actor
names. Remove duplicate ChannelID from file (only put alternative
ID's). better actor parsing

B<2004-04-05 epaepa/nielm> - Handle user input better during config
(CTRL-D, CTRL-H), use substrings not regexps for category/channel
matching to avoid nastyness when a user enters a bad regexp. Add magic
category *NONE* and *ALL* for category matching.

B<2004-04-15 nielm> - yet more cleanup in parsing actor names, ignore
programmes with no titles.

B<2005-03-12 nielm> - no function changes: just changes to the
configuration section to use XMLTV::ask, and updates to the
channel_ids files

B<2005-09-22 nielm> - www.telemoustique.be no longer works: quick
and dirty fix: use www.telepocket.be instead.

=cut

# TODO
#
# Merge fr and nl configs to allow single config file.
#
#
# Handle listings where a program is shown again later in the day
# without a separate lsting for it: eg:
#    <desc lang="fr">les moments les plus delirants de
#    l'emission. (13.30, 16.15, 20.45, 0.30)</desc>
#    <desc lang="fr">Srie anime. La dcision de Petit-Coeur 
#    (R.  17.30 et 24.00)</desc>
#    <desc lang="fr">Srie australienne (R.  18.00)</desc>
# implies this program will be shown at these later times... 
# 
#
# Handle Followed by 'Suivi' in Fremch descriptions
#   <desc lang="fr">(R.) Suivi de Le Shopping.</desc>
#   <desc lang="fr">Suivi,  14.40, de Tranche de rire.</desc>
#   <desc lang="fr">suivi  14.10 de La Boutique - 14.40 Tranche de rire.</desc>
#   <desc lang="fr">Srie quotidienne franaise suivie,  19.55, de la Mto.</desc>
#   <desc lang="fr">suivi de L'invit - La mto</desc>
#   <desc lang="fr">suivi de L'invit - La mto. Pascal Vrebos reoit Laurette Onkelinx, Ministre de la Justice (PS).</desc>
#
# Handle grouped programmes
#     <desc lang="fr">Le lutin Plop
#      - 7.00 La cour de rcr (R.) 
#      - 7.25 Pepper Ann (R.) 
#      - 7.50 Jim Bouton.</desc>
#


use strict;
use XMLTV::Version '$Id: tv_grab_be.in,v 1.8 2006/04/12 16:59:52 mattiasholmlund Exp $ ';
use XMLTV::Capabilities qw/baseline manualconfig cache share/;
use XMLTV::Description 'Belgium';
use IO::Socket;
use LWP::Simple;
use Date::Manip;
use Getopt::Long;
use HTML::Entities;
use XMLTV;
use XMLTV::Memoize;
use XMLTV::Ask;
use XMLTV::ProgressBar;
use XMLTV::DST;
use XMLTV::Config_file;
use XMLTV::Get_nice; 
use XMLTV::Date qw(parse_date); 
use XMLTV::Usage <<END
To configure:     $0 --configure [--config-file FILE] [--slow] [--gui OPTION]
To grab listings: $0 [--config-file FILE] [--output FILE] 
                     [--days N] [--offset N] [--quiet] [--slow] [--gui OPTION]
To list channels: $0 [--output FILE] [--quiet] [--config-file FILE] --list-channels
To show capabilities: $0 --capabilities
To show version: $0 --version
END
  ;

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

sub get_url( $ );
sub get_programmes( $$$$$$ );
sub get_programme_summary( $$$$ );
sub get_programme_detailed_info($$);
sub parse_programme_details($$); # ref of prog hash, array of descr strings
sub get_channels();
sub get_categories();
sub get_available_dates();
sub be_to_xmltv( $ );
sub xmltv_to_be( $ );
sub grab( $$ );
sub configure();

# GLOBAL CONSTANTS
my $LANG_FR = 'fr';
my $LANG_NL = 'nl';

# language-dependant constants
my %DOMAIN = ( $LANG_FR => 'telepocket.be',
		 $LANG_NL => 'teveblad.be' );
my %BASE_URL = ( $LANG_FR => "http://www.$DOMAIN{$LANG_FR}/fr/",
		 $LANG_NL => "http://www.$DOMAIN{$LANG_NL}/ndl/");

# channel to use for getting dates
my %DATE_CH   = ( $LANG_FR => 'LA%20UNE',
		 $LANG_NL => 'TV1' );

my $SUMMARY_PATH = "zender.asp";
my $DETAIL_PATH = "detail.asp?progid=";

# populated from config file 
my @detailgenre;
my $detailstarttime;
my $detailstoptime;
my %get_channel_detail;
my $LANG;

#stats
my $numwebgets=0;
my $kbwebgets=0;
my $statstarttime=time();

# Check options.  First do the undocumented --cache option (to cache
# get(), which retrieves web pages), then the normal ones.
#
my $using_cache 
     = XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux'); 
my ($opt_days,
    $opt_help,
    $opt_output,
    $opt_input,
    $opt_share,
    $opt_slow,
    $opt_gui,
    $opt_configure,
    $opt_config_file,
    $opt_offset,
    $opt_quiet,
    $opt_list_channels,
   );
# No default for $opt_days, we determine it from the site.
$opt_offset = 0; # default today
$opt_quiet  = 0; # default
GetOptions('days=i'        => \$opt_days,
           'help'          => \$opt_help,
           'configure'     => \$opt_configure,
           'slow'          => \$opt_slow,
           'gui:s'         => \$opt_gui,
           'config-file=s' => \$opt_config_file,
           'output=s'      => \$opt_output,
           'offset=i'      => \$opt_offset,
	   'list-channels' => \$opt_list_channels,
           'quiet'         => \$opt_quiet,
           'input=s'       => \$opt_input, # undocumented -- debug mode: 
	                                   # read data from html file,
	                                   # no web page gets apart
	                                   # from program details

           'share=s'       => \$opt_share, # undocumented 
                                           # redefine share dir
          )
  or usage(0);
die 'number of days must not be negative'
  if (defined $opt_days && $opt_days < 0);
if ($opt_help) {
    usage(1);
}

# Date::Manip has a bug where 'now' will be wrong if you change the
# timezone.  It won't be correctly converted from the system timezone
# to the new one.  So we call parse_date('today midnight') _before_
# Date_Init().
#
my $today = DateCalc(parse_date('today midnight'), "$opt_offset days");
Date_Init('TZ=+0000');

# share/ directory for storing channel mapping files.  This next line
# is altered by processing through tv_grab_be.PL.  But we can use the
# current directory instead of share/tv_grab_be for development.
#
# The 'source' file tv_grab_be.in has $SHARE_DIR undef, which means
# use the current directory.  In any case the directory can be
# overridden with the --share option (useful for testing).
#
my $SHARE_DIR='/usr/share/xmltv'; # by grab/be/tv_grab_be.PL
$SHARE_DIR = $opt_share if defined $opt_share;
my $OUR_SHARE_DIR = (defined $SHARE_DIR) ? "$SHARE_DIR/tv_grab_be" : '.';
(my $CHANNEL_NAMES_FILE_BASE = "$OUR_SHARE_DIR/channel_ids_") =~ tr!/!/!s;

XMLTV::Ask::init($opt_gui);

# Tables to convert between telemoustique / teveblad and XMLTV ids of channels.
# The way to access these is through the routines be_to_xmltv() and
# xmltv_to_be(), not directly.  Those will deal sensibly with a new 
# channel that isn't mentioned in the file.
#
my (%be_to_xmltv, %xmltv_to_be, %extra_dn, %ch_warn, %logourl);
my $line_num = 0;

foreach my $CURLANG ( $LANG_FR, $LANG_NL ) {
    my $CHANNEL_NAMES_FILE = ( $CHANNEL_NAMES_FILE_BASE . $CURLANG );
    $line_num=0;
    foreach (XMLTV::Config_file::read_lines($CHANNEL_NAMES_FILE, 1)) {
        ++ $line_num;
        next unless defined;
        my $where = "$CHANNEL_NAMES_FILE:$line_num";
        my @fields = split(/:/,$_,5);
        die "$where: wrong number of fields: " . (scalar @fields)
            if @fields < 4 or @fields > 5;
        my ($xmltv_id, $be_id, $extra_dn, $logourl, $ch_warn) = @fields;
	die "$where Sanonma id not specified" 
	    if ( not defined $be_id || $be_id eq '' );
        warn "$where: $CURLANG Sanoma id $be_id seen already\n"
            if defined $be_to_xmltv{$CURLANG}{$be_id};
        $be_to_xmltv{$CURLANG}{$be_id} = $xmltv_id;
        warn "$where: $CURLANG XMLTV id $xmltv_id seen already\n"
            if defined $xmltv_to_be{$CURLANG}{$xmltv_id};
        $xmltv_to_be{$CURLANG}{$xmltv_id} = $be_id;
        $extra_dn{$CURLANG}{$xmltv_id} = $extra_dn 
	    if ( defined $extra_dn && $extra_dn ne '' );
        $logourl{$CURLANG}{$xmltv_id} = $logourl 
	    if ( defined $logourl && $logourl ne '' );
        $ch_warn{$CURLANG}{$xmltv_id} = $ch_warn 
	    if ( defined $ch_warn && $ch_warn ne '' );
    }
}
t 'xmltv_to_be: ' . d \%xmltv_to_be;
t 'be_to_xmltv: ' . d \%be_to_xmltv;
t 'extra_dn: ' . d \%extra_dn;
t 'ch_warn: ' . d \%ch_warn;

# Arguments for XMLTV::Writer.
my %g_args = ();
if (defined $opt_output) {
    die "cannot have both --output and --configure\n" if $opt_configure;
    my $fh = new IO::File ">$opt_output";
    die "cannot write to $opt_output\n" if not $fh;
    %g_args = (OUTPUT => $fh);
}

# Find the configuration file.  This grabber needs it even for listing
# channels since the channels available depend on the language.
#
my $config_file
  = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_be', $opt_quiet);

if ($opt_configure) {
    configure();
    exit;
}

# Not configuring - need to read an existing config file.
my @config_lines = XMLTV::Config_file::read_lines($config_file);

# Read the configuration file for language option
# language <F|D>
foreach (@config_lines) {
    ++ $line_num;
    next if not defined;
    my $where = "$config_file:$line_num";
    if (/^language\s+(.+)/) {
	if ( $1 eq $LANG_FR || $1 eq $LANG_NL) {
	    $LANG=$1;
	}
	else {
	    die "$where: invalid language defined in conf file\n";
	}
    }
}
die "language not defined in $config_file" if (not defined $LANG );

# Stuff at the top of any output XML.
my $metadata = { 'source-info-url'     => "$BASE_URL{$LANG}$SUMMARY_PATH",
		 'source-info-name'    => "$DOMAIN{$LANG}",
		 'generator-info-name' => 'XMLTV',
		 'generator-info-url'  =>
		 'http://membled.com/work/apps/xmltv/',
	       };

if ($opt_list_channels) {
    # Could check usage here to see --days etc. were not specified but
    # I can't be bothered.
    #
    my %channels = get_channels; # uses $LANG
    my $writer = new XMLTV::Writer(%g_args, encoding =