tv_grab_fr_telerama_pg_0.2

#!/usr/bin/perl

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

=head1 NAME

tv_grab_fr_telerama - Grab TV listings for France.

=head1 SYNOPSIS

 To configure:
   tv_grab_fr --configure [--config-file FILE]
 To grab listings:
   tv_grab_fr [--config-file FILE] [--output FILE] [--days N]
    [--offset N] [--quiet] [--noautocorrect] [--perdays] [--perweeks]
    [--ch_prefix prefix] [--ch_postfix postfix]
 To show capabilities:
   tv_grab_fr --capabilities
 To show version:
   tv_grab_fr --version
 Help:
   tv_grab_fr --help

=head1 DESCRIPTION

Output TV listings for several channels available in France (Hertzian,
Cable/satellite, Canal+ Sat).  The data comes from
guidetv-iphone.telerama.fr.  The default is to grab as many days as possible
from the current day onwards. The program description are
downloaded.

B<--configure-more-channels> Use this option to create AUTRES CHAINES list.
 This allow to grab listings for some channels that are not in automatically
generated lists.

B<--configure> Grab channels informations from the website and ask for
channel type and names.

B<--config-file FILE> Use FILE as config file instead of the default config
file. This allow to have different config files for i.e. different apps.

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<--output FILE> Write to FILE rather than standard output.

B<--days N> Grab N days starting from today, rather than as many as
possible. Due to the website organization, the speed depends on
the --days value Default value is 11.

B<--offset N> Start grabbing N days from today, rather than starting
today.  N may be negative. Due to the website organization, N cannot
be inferior to -1.Default value is 0

B<--ch_prefix S> (string): string to add at the begining of XMLTV channel id
Default value is "C"

B<--ch_postfix S> (string): string to add at the end of XMLTV channel id
Default value is ".telerama.fr"

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

B<--noautocorrect> Disable the new time overlapping autocorrection mechanism.

B<--perdays> Actually do nothing since "per days" is already set as default
grabbing mode. This option is kept in the event of "per weeks" set back as
default. In this case, it could be use to activate the "per days" grabbing mode.

B<--perweeks> Actually do nothing since "per days" is already forced as default

B<--capabilities> Show which capabilities the grabber supports. For more
information, see L<http://xmltv.org/wiki/xmltvcapabilities.html>

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

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

=head1 SEE ALSO

L<xmltv(5)>

=head1 AUTHOR

Zubrick, zubrick@number6.ch
Modified by patrick-g  pgn<dot>ltech<at>free<dot>fr

=head1 LICENSE

This program is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation, either version 3 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program.  If not, see <http://www.gnu.org/licenses/>.
=cut


use XMLTV::Usage <<END
$0: get French television listings in XMLTV format
To configure AUTRES CHAINES list: tv_grab_fr --configure-more-channels
To configure: tv_grab_fr --configure [--config-file FILE]
To grab listings: tv_grab_fr [--config-file FILE] [--output FILE] [--days N]
    [--offset N] [--quiet] [--noautocorrect] [--perdays] [--perweeks]
    [--ch_prefix prefix] [--ch_postfix postfix]
To show capabilities: tv_grab_fr --capabilities
To show version: tv_grab_fr --version
Help: tv_grab_fr --help
END
  ;

use warnings;
use strict;
use XMLTV::Version '$Id: tv_grab_fr_telerama,v 1.8 2011/08/20 22:30:00 zubrick Exp $ ';
use XMLTV::Capabilities qw/baseline manualconfig cache/;
use XMLTV::Description 'France (telerama)';
use Getopt::Long;
use HTML::Entities; # parse entities
use IO::File;
use URI;
use Date::Manip;
use XMLTV;
use XMLTV::Ask;
use XMLTV::ProgressBar;
use XMLTV::Mode;
use XMLTV::Config_file;
use XMLTV::DST;
use LWP;
use XMLTV::Get_nice;
use XMLTV::Memoize;
use File::Temp;
use LWP::Simple;
use LWP::UserAgent;
use POSIX;
use Encode;

#***************************************************************************
# Main declarations
#***************************************************************************
my $LANG = "fr";
my $VERSION   = "20082011-02";

# FIXME: Temporary avoid XML warnings (to be investigated)
#no warnings;

# Slot of hours according to the website (needed to build the URL)
my @offsets = (2, 3, 4, 5, 6, 7);
# Slot of days for day per day grabbing
# my @days = (2, 3, 4, 5, 6, 7, 8, 9);

my $Delay = 2; # in seconds
my $FailOnError = 1; # Fail on fetch error

my %errors = ();
my $last_get_time;

my $progexist;
my %prevprog;
my $prevtitle;
my $prevstart;
my $prevstop;

my $channel_postfix = ".telerama.fr";
my $channel_prefix = "C";

#***************************************************************************
# Global variables allocation according to options
#***************************************************************************
XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux');

##patch: tigerlol: correction des chevauchements d'horaire
my ($opt_days,  $opt_help,  $opt_output,  $opt_per_days, $opt_per_weeks, $opt_offset,  $opt_gui, $opt_quiet,  $opt_list_channels, $opt_config_file, $opt_configure, $opt_noautocorrect, $opt_morechannels, $opt_verytv );
##/patch

$opt_per_weeks = 0;
$opt_quiet  = 0;
# The website is able to store at least 11 days from now
my $default_opt_days = 11;
$opt_output = '-'; # standard output
GetOptions('days=i'    => \$opt_days,
     'help'      => \$opt_help,
     'output=s'  => \$opt_output,
     'offset=i'  => \$opt_offset,
     'quiet'     => \$opt_quiet,
     'configure' => \$opt_configure,
     'config-file=s' => \$opt_config_file,
     'gui:s'     => \$opt_gui,
     'list-channels' => \$opt_list_channels,
     'perdays' => \$opt_per_days,
     'perweeks' => \$opt_per_weeks,
     'ch_prefix=s'  => \$channel_prefix,
     'ch_postfix=s'  => \$channel_postfix,
##patch: tigerlol: correction des chevauchements d'horaire
     'noautocorrect' => \$opt_noautocorrect,
##Gestion des channels non declares dans les listes "officielles"
     'configure-more-channels' => \$opt_morechannels,
     'verytv' => \$opt_verytv
##/patch
    )
  or usage(0);

my $CHANNEL_GRID;
my $CHANNEL_GRID_PAGE;
my $CHANNEL_ICON_PAGE;
my $ROOT_URL;


my $ua = LWP::UserAgent->new;

if($opt_verytv) {
    $CHANNEL_GRID = 'http://91.121.66.148/~verytv/procedures/ListeChaines.php';
    $CHANNEL_GRID_PAGE = "http://91.121.66.148/~verytv/procedures/LitProgrammes1Chaine.php?date=";
    $ROOT_URL  = 'http://91.121.66.148';
    $ua->agent("VeryTV/2.7 CFNetwork/459 Darwin/10.0.0d3");
} else {
    $CHANNEL_GRID = 'http://guidetv-iphone.telerama.fr/verytv/procedures/ListeChaines.php';
    $CHANNEL_GRID_PAGE = "http://guidetv-iphone.telerama.fr/verytv/procedures/LitProgrammes1Chaine.php?date=";
    $CHANNEL_ICON_PAGE = "http://guidetv-iphone.telerama.fr/verytv/procedures/images/";
    $ROOT_URL  = 'http://guidetv-iphone.telerama.fr';
    $ua->agent("Telerama/1.2 CFNetwork/459 Darwin/10.0.0d3");
}
$ua->env_proxy;


#***************************************************************************
# Options processing, warnings, checks and default parameters
#***************************************************************************
die 'Number of days must not be negative'  if (defined $opt_days && $opt_days < 0);
die 'Cannot get more than one day before current day' if (defined $opt_offset && $opt_offset < -1);
usage(1) if $opt_help;

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

# The options can be used, but we default them if not set.
$opt_offset = 0 if not defined $opt_offset;
$opt_days = $default_opt_days if not defined $opt_days;

# Force the per days option in all cases
if ( $opt_per_weeks == 0 ) {
  $opt_per_days = 1;
}

if ( (($opt_offset + $opt_days) > $default_opt_days) or ($opt_offset > $default_opt_days) ) {
    $opt_days = $default_opt_days - $opt_offset;
    if ($opt_days < 0) {
        $opt_offset = 0;
        $opt_days = $default_opt_days;
    }
    say <<END
The website does not handle more than $default_opt_days days.
So the grabber is now configure with --offset $opt_offset --days $opt_days
END
;
}

# Info about autocorrect mode
if ( !$opt_quiet ) {
  if ( !$opt_configure && !$opt_morechannels ) {
    if ( $opt_noautocorrect ) {
      say "Autocorrect DESACTIVE! - Autocorrect DISABLED!\n";
    } else {
      say "Autocorrect ACTIVE! - Autocorrect ENABLED!\n";
    }
  }
}

#***************************************************************************
# Last init before doing real work
#***************************************************************************
my %results;
my $lastdaysoffset = $opt_offset + $opt_days - 1;
my $checkDummySlot = 0;

# Now detects if we are in configure mode
my $mode = XMLTV::Mode::mode('grab', # default
                        $opt_configure => 'configure',
                        $opt_list_channels => 'list-channels',
                        $opt_morechannels  => 'confmorechannels' );

# File that stores which channels to download.
my $config_file = XMLTV::Config_file::filename($opt_config_file, 'tv_grab_fr_telerama', $opt_quiet);

#***************************************************************************
# Sub sections
#***************************************************************************
sub get_channels( );
sub return_other_channels( );
sub build_other_channel_filename();
sub get_more_channel_icon( $ );
sub process_channel_grid_page( $$$$ );
sub debug_print( @ );
sub get_page( $ );

# Set this to 1 of you debug strings
my $DEBUG_FR = 0;
# Internal debug functions
sub debug_print( @ ) {
  if ($DEBUG_FR) { print @_; }
}

sub xmlencoding {
    # encode for xml
    $_[0] =~ s/</&lt;/g;
    $_[0] =~ s/>/&gt;/g;
    $_[0] =~ s/&/\%26/g;
    return $_[0];
}


#***************************************************************************
# Configure mode
#***************************************************************************
if ($mode eq 'configure') {
    XMLTV::Config_file::check_no_overwrite($config_file);
    open(CONF, ">$config_file") or die "Cannot write to $config_file: $!";

    #my $bar = new XMLTV::ProgressBar('getting channel lists', scalar grep { $_ } @gtwant) if not $opt_quiet;
    my %channels_for;
    my %channels = get_channels();
    die 'No channels could be found' if not %channels;


    my %asked;

    # Ask about each channel (unless already asked).
    my @chs = grep { not $asked{$_}++ } sort keys %channels;
    my @names = map { $channels{$_}{name} } @chs;
    my @qs = map { "add channel $_?" } @names;
    my @want = ask_many_boolean(1, @qs);
    foreach (@chs) {
        my $w = shift @want;
        warn("cannot read input, stopping channel questions"), last if not defined $w;
        # Print a config line, but comment it out if channel not wanted.
        print CONF '#' if not $w;
        print CONF "channel $_ $channels{$_}{name};$channels{$_}{icon}\n";
    }

    close CONF or warn "cannot close $config_file: $!";
    say("Finished configuration.");
    exit();
}

#***************************************************************************
# "Configure more channels" mode
#***************************************************************************
sub display_otherchannels_list(\%) {
    my %chlist = %{(shift)};

    say ">>>>>> Current list <<<<<<";
    foreach my $chid (keys %chlist) {
        say "Channel ID: ". $chid." - Name: " . $chlist{$chid}{name} .
            " - Icon: ". $chlist{$chid}{icon};
    }
    say ">>>>>> List end <<<<<<";
}

if ($mode eq 'confmorechannels') {
    # Display info message, pointing to the forum thread
    my $input_file_notempty = 0;
    my %morechannels = return_other_channels();
    display_otherchannels_list(%morechannels);
    if ( (scalar keys  %morechannels) > 0 ) {
        $input_file_notempty= 1;
    }
    my $choice = "";
    my ($chid, $chname, $chicon);

    while ( !($choice eq "exit")) {
        $choice = ask_choice( "Select command to configure OTHERCHANNELS", "add", ("add", "remove", "view list", "save&exit", "exit") );
        my $exit = 0;
        if ($choice eq "add" ) {
            while ($exit == 0) {
                $chid = ask('Enter channel ID : ');
                $chname = ask('Enter channel name : ');
                if ( !($chid =~ /^[0-9]*$/) ) {
                    say ("Enter a numeric value for channel id");
                } else {
                    if ( $chname eq "" ) {
                        say ("Enter a string for the name of the channel");
                    } else {
                        $exit = 1;
                    }
                }
            }
            say("Testing channel $chid - $chname ...");
            my $chicon = get_more_channel_icon( $chid );
            $morechannels{$chid} = {'name'=>$chname, 'icon'=>$chicon};
        }
        if ($choice eq "remove" ) {
            display_otherchannels_list(%morechannels);
            my $chid = ask('Enter the channel id to remove it (see list above): ');
            if ( defined $morechannels{$chid} ) {
                $chname = $morechannels{$chid}{name};
                delete $morechannels{$chid};
                say ("Channel $chname removed");
            } else {
                say("Channel $chid does not exist in the list");
            }
        }
        if ($choice eq "view list" ) {
            display_otherchannels_list(%morechannels);
        }
        if ($choice eq "save&exit") {
            my $morechannels_file = build_other_channel_filename();
            # Then write the file
            if ( (scalar keys  %morechannels) > 0 ) {
                open(CONFMORE, ">$morechannels_file") or die "Cannot write to $morechannels_file: $!";
                foreach $chid (keys %morechannels) {
                    if (!( $morechannels{$chid}{name} eq 'DELETED' )) {
                        print CONFMORE "channel $chid $morechannels{$chid}{name};$morechannels{$chid}{icon}\n";
                    }
                }
                close CONFMORE or warn "cannot close $morechannels_file: $!";
                display_otherchannels_list(%morechannels);
                say ('Channel list saved. Launch now a --configure mode to add them into the legacy config');
            } else {
                unlink ($morechannels_file);
                say ('No channels to be configure, file deleted.');
            }
            $choice = "exit";
        }
    }
    say("Finished configuration for OTHERCHANNELS.");
    exit();
}

#***************************************************************************
# Check mode checking and get configuration file
#***************************************************************************
die if $mode ne 'grab' and $mode ne 'list-channels';

my @config_lines;
if ($mode eq 'grab') {
    @config_lines = XMLTV::Config_file::read_lines($config_file);
}

#***************************************************************************
# Prepare the XMLTV writer object
#***************************************************************************
my %w_args;
if (defined $opt_output) {
    my $fh = new IO::File(">$opt_output");
    die "cannot write to $opt_output: $!" if not defined $fh;
    $w_args{OUTPUT} = $fh;
}

$w_args{encoding} = 'UTF-8';

my $writer = new XMLTV::Writer(%w_args);
$writer->start
  ({ 'source-info-url'     => $ROOT_URL,
     'source-data-url'     => $ROOT_URL,
     'generator-info-name' => 'XMLTV',
     'generator-info-url'  => 'http://mythtv-fr.org/',
   });

#***************************************************************************
# List channels only case
#***************************************************************************
if ($mode eq 'list-channels') {
    # Get a list of available channels, according to the grid type
    my @gts;# = sort keys %GridType;
    my @gtnames;# = map { $GridType{$_} } @gts;
    my @gtqs = map { "List channels for grid : $_?" } @gts;
    my @gtwant = ask_many_boolean(1, @gtqs);

    my %seen;
    foreach (@gts) {
        my $gtw = shift @gtwant;
        my $gtname = shift @gtnames;
        if ($gtw) {
            say  "Now getting grid : $_ \n";
            my %channels = get_channels( );
            die 'no channels could be found' if (scalar(keys(%channels)) == 0);
            foreach my $ch_did (sort(keys %channels)) {
                my $ch_xid = "C".$ch_did.".telepoche.com";
                $writer->write_channel({ id => $ch_xid,
                                         'display-name' => [ [ $channels{$ch_did}{name} ] ],
                                         'icon' => [{src=>$ROOT_URL.$channels{$ch_did}{icon}}] })
                unless $seen{$ch_xid}++;
            }
       }
     }
     $writer->end();
     exit();
}

#***************************************************************************
# Now the real grabbing work
#***************************************************************************
die if $mode ne 'grab';

#***************************************************************************
# Build the working list of channel name/channel id
#***************************************************************************
my (%channels, $chicon, $chid, $chname);
my $line_num = 1;
foreach (@config_lines) {
    ++ $line_num;
    next if not defined;

    # Here we store the Channel name with the ID in the config file, as the XMLTV id = Website ID
    if (/^channel:?\s+(\S+)\s+([^\#]+);([^\#]+)/) {
        $chid = $1;
        $chname = $2;
        $chicon = $3;
        $chname =~ s/\s*$//;
        $channels{$line_num} = {'chid'=>$chid, 'name'=>$chname, 'icon'=>$chicon};
    } else {
        warn "$config_file:$line_num: bad line $_\n";
    }
}

#***************************************************************************
# Now process the days by getting the main grids.
#***************************************************************************
my @to_get;
warn "No working channels configured, so no listings\n" if not %channels;
my $script_duration = time();

# The website stores channel information by hour area for a whole week !
my $ind;
foreach $ind (sort { $a <=> $b } keys %channels) {
    my $chid = $channels{$ind}{chid};
    my $url;
    my $i;
    my $dayoff;
    $writer->write_channel({ id => $channel_prefix.$chid.$channel_postfix, 'display-name' => [[$channels{$ind}{name}]], 'icon' => [{src=>$channels{$ind}{icon}}]});
    if ( $opt_per_days ) {
        for ($i=$opt_offset; $i < $opt_offset+$opt_days; $i++ ) {
            #debug_print( "i: $i\n");
            $dayoff = strftime("%Y-%m-%d", gmtime(time() + 3600 * 24 * $i));
            #debug_print( "dayoff  : " . gmtime(time() + 3600 * 24 * $i) ."\n");

            $url = $CHANNEL_GRID_PAGE.$dayoff."&chaine=".$chid;
            push @to_get, [ $url, $chid, $i ];
        }
    } else {
        foreach (@offsets) {
            #$url = $GRID_BY_CHANNEL . "$chid&h=$_";
            push @to_get, [ $url, $chid, $_ ];
        }
    }
}


my $bar = new XMLTV::ProgressBar('getting listings', scalar @to_get)  if not $opt_quiet;
Date_Init("TZ=UTC");

foreach (@to_get) {
    my ($url, $chid, $slot) = @$_;
    process_channel_grid_page($writer, $chid, $url, $slot);
    update $bar if not $opt_quiet;
}

##patch: tigerlol: correction des chevauchements d'horaire
if ( !$opt_noautocorrect ) {
    if ( $progexist ) {
        # Ecriture du programme restant en memoire (au cas ou)
        if ( !$results{$prevprog{start}.$chid} ) {
            #print STDERR "!!!Ecriture du dernier programme sauvegarde: " . $prevtitle . "(" . $prevprog{channel} . ")\n";
            $results{$prevprog{start}.$chid} = "1";
            $writer->write_programme(\%prevprog);
        }
        $progexist = 0;
    }
}
##/patch

$writer->end();
$bar->finish() if not $opt_quiet;

# Print the duration
$script_duration = time() - $script_duration;
print STDERR "Grabber process finished in " . $script_duration . " seconds.\n" if not $opt_quiet;

#***************************************************************************
# Specific functions for grabbing information
#***************************************************************************
# Build the filename used to stored channels configured manually
sub build_other_channel_filename() {
    # Get the file name/path for OTHERCHANNELS
    my $home = $ENV{HOME};
    $home = '.' if not defined $home;
    my $conf_dir = "$home/.xmltv";
    (-d $conf_dir) or mkdir($conf_dir, 0777)
    or die "cannot mkdir $conf_dir: $!";
    return "$conf_dir/OTHERCHANNELS";
}

# Return the tables of the channels built manally
sub return_other_channels( ) {

    my $morechannels_file = build_other_channel_filename();

    my @morechannels_lines;
    if (-e $morechannels_file && ((-s $morechannels_file)>0) ) {
        @morechannels_lines = XMLTV::Config_file::read_lines($morechannels_file);
    }
    my %morechannels;
    my ($chid, $chname, $chicon);
    my $line_num = 0;

    # Build the table and display
    foreach (@morechannels_lines) {
        next if not defined;

        # Here we store the Channel name with the ID in the config file, as the XMLTV id = Website ID
        if (/^channel:?\s+(\S+)\s+([^\#]+);([^\#]+)/) {
            $chid = $1;
            $chname = $2;
            $chicon = $3;
            $chname =~ s/\s*$//;
            $morechannels{$chid} = {'name'=>$chname, 'icon'=>$chicon};
        }
        $line_num++;
    }
    return %morechannels;
}

# Return the link to the icon. Parameter : channel id
sub get_more_channel_icon( $ ) {
    my $chid = shift;
    my $today = strftime("%Y-%m-%d", localtime());
    my $url;# = $CHECK_CHANNEL_URL.$chid.'/telepoche/soiree/'.$today;
    print $chid;
    # Get the current page
    my $t = get_nice_tree($url);

    debug_print( "URL  : " . $url ."\n");
    # Set by default an EMPTY logo
    my $chicon = "EMPTY";

    foreach my $cellTree ( $t->look_down( "_tag", "img") ) {
        my $chiconsrc = $cellTree->attr('src');
        if ( $chiconsrc =~ /\/medias\/chaines\/(.*)/ ) {
            $chicon = "http://telepoche.guidetele.com/medias/chaines/".$1;
        }
    }
    $t->delete(); undef $t;
    return $chicon;
}

#Get the channel from a grid id, including OTHERCHANNELS mode
sub get_channels( ) {
    my %channels;

    # Get the current page
    my $page = get_page($CHANNEL_GRID);

    debug_print( "URL  : " . $CHANNEL_GRID ."\n");
    #debug_print($page);
    my @lines = split(/:\$\$\$:/,Encode::from_to($page, "windows-1252", "UTF8"));
    my $chicon = "";
    foreach my $line ( @lines ) {
        my ($chid,$chname) = split (/\$\$\$/,$line);
        debug_print "Found channel : $chid - " . $chname . "\n";
        my $chicon="http://localhost/logos/logo" . $chid . "gif";
        $channels{$chid} = {'name' =>  $chname, 'icon' => $chicon };
    }

    undef $page;
    return %channels;
}


sub process_channel_grid_page( $$$$ ) {
    my ($writer, $chid, $url, $slot) = @_;

    my $page = get_page($url);
    debug_print("Getting URL : ".$url."\n");
    #print "Getting URL : ".$url."\n";
    my @lines = split(/:\$\$\$:/,$page);

    my ($chname, $title, $starthour, $endhour, $genre, $description, $specialfield, $age, $field1, $stars, $critic, $date, $field4, $day, $year, $mount, $showview);

    foreach my $line ( @lines ) {

    Encode::from_to($line, "windows-1252", "UTF8");


    if($opt_verytv) {
        ($chid, $chname, $title, $starthour, $endhour,
        $genre, $description, $specialfield, $date,
        $age, $stars, $showview) = split(/\$\$\$/,$line);
        ($year,$mount,$day) = split(/-/,$date);
        $age=0;
    } else {
        ($chid, $chname, $title, $starthour, $endhour,
        $genre, $description, $specialfield,
        $age, $field1, $stars, $critic, $date, $field4) = split(/\$\$\$/,$line);
        ($day,$mount,$year) = split(/\//,$date);
    }

    debug_print("date:".$date."\n");

    $date=$year.$mount.$day;
    debug_print($title." - ".$starthour." - ".$endhour."\n");
    debug_print("description:".$description."\n");
    debug_print("genre:".$genre."\n");
    debug_print("specalfield: ".$specialfield."\n");

    my ($shh,$shm,$shs) = split(/:/,$starthour);
    my $imgurl= $CHANNEL_ICON_PAGE.$year.'-'.$mount.'-'.$day.'_'.$chid.'_'.$shh.':'.$shm.'.jpg';

    $starthour =~ s/://g;
    $endhour =~ s/://g;

    my (@specials)=split(/\n/,$specialfield);

    my $start = $date.$starthour."";
    my $stop  = $date.$endhour."";
    debug_print($start.">".$stop."\n");

    if ( $stop < $start ) {
        $stop  = &UnixDate(&DateCalc($stop, "+1 day"), "%Y%m%d%H%M%S");
        die 'could not add one day to stop time' if not $stop;
        debug_print("One day added to end of last show.\n");
    }

    $start = utc_offset( $start, "+0100");
    $stop  = utc_offset( $stop , "+0100");
    my %prog = (channel  => $channel_prefix.$chid.$channel_postfix,
                    title    => [ [ $title ] ],             # lang unknown
                    start    => $start,
                    stop     => $stop
                    );
    debug_print($start.">".$stop."\n");

    my $subgenre;
    my $episode;
    my $season;
    my $epstring;
    my $rating2;
    $episode = "-1";
    $season = "-1";
    foreach my $special (@specials) {
        if ($special =~ m/Durée ; ([0-9]+) min/) {
            $prog{length} = $1;
        } elsif ($special =~ /Episode : /) {
            debug_print("Episode:".$special."\n");
            $description = $special." - ".$description;
            $special =~ s/Episode : //i;
            $episode = $special;
        } elsif ($special =~ /Saison : /) {
            debug_print("Saison:".$special."\n");
            $description = $special." - ".$description;
            $special =~ s/Saison : //i;
            $season = $special;
        } elsif ($special =~ s/Sous-titre : //i) {  # Attention à l'ordre avec le elsif suivant
            debug_print("Sous-titre:".$special."\n");
            $prog{'sub-title'} = [ [ $special ] ];
        } elsif ($special =~ m/Sous-titr/i) {  # présence de sous-titrage teletext
            debug_print("Sous-titré:".$special."\n");
            $prog{subtitles} = [ { type => 'teletext', language => ['fr'] } ]
        } elsif ($special =~ m/VOST/i) {   # présence de sous-titrage dans l'image'
            debug_print("Sous-titré:".$special."\n");
            $prog{subtitles} = [ { type => 'onscreen', language => ['fr'] } ]
        } elsif ($special =~ s/Sc.*nariste//i || $special =~ s/Sc.*nario//i) {
            debug_print("Auteurs:".$special."\n");
            my @writers = split(/, /,$special);
            foreach my $auteur (@writers) {
                push @{$prog{credits}{writer}}, $auteur;
            }
        } elsif ($special =~ s/Acteurs : //i) {
            debug_print("Acteurs:".$special."\n");
            my @acteurs = split(/, /,$special);
            foreach my $acteur (@acteurs) {
                push @{$prog{credits}{actor}}, $acteur;
            }
       } elsif ($special =~ s/R.alisateur : //i) {
            push @{$prog{credits}{director}}, $special;
      } elsif ($special =~ s/Pr.*sentateur : //i) {
            my @presenters = split(/, /,$special);
            foreach my $presenter (@presenters) {
                push @{$prog{credits}{presenter}}, $presenter ;
            }
        } elsif ($special =~ s/Invit.*s : //i) {
            my @guests = split(/, /,$special);
            foreach my $guest (@guests) {
                push @{$prog{credits}{guest}}, $guest ;
            }
        } elsif ($special =~ s/Musique : //i) {
            my @musics = split(/, /,$special);
            foreach my $music (@musics) {
# il faut XMLTV >= 0.5.58 pour que ce champ soit reconnu
# sinon ça genere un warning mais le fichier xml est quand meme ecrit.
                push @{$prog{credits}{composer}}, $music ;
            }
        } elsif ($special =~ m/Showview : ([0-9]+)/) {
            $prog{showview} = $1;
        } elsif ($special =~ s/Ann.e : //i) {
            $prog{'date'} = $special;
        } elsif ($special =~ /St.r.o/) {
            $prog{'audio'}{stereo} = "stereo";
        } elsif ($special =~ m/Dolby digital/) {
            $prog{'audio'}{stereo} = "digital";
        } elsif ($special =~ m/Dolby 5.1/) {
            $prog{'audio'}{stereo} = "surround";
        } elsif ($special =~ m/Dolby/) {
            $prog{'audio'}{stereo} = "dolby";
        } elsif ($special =~ m/VM/) {
            $prog{'audio'}{stereo} = "bilingual";
        } elsif ($special =~ m/Pays : (.*)/) {
            $prog{country} = $1;
       } elsif ($special =~ s/Genre : //i) {
            $subgenre = $special;
        } elsif ($special =~ m/Titre original : (.*)/) {
            $prog{title_orig} = $1;
        } elsif ( ($special =~ m/In.*dit/) || ($special =~ m/Premi.*re diffusion/) ) {
            $prog{premiere} = [];
        } elsif ($special =~ m/Rediffusion/) {
            $prog{'previously-shown'} = {};
        } elsif ($special =~ m/En 16:9/) {
            $prog{video}{aspect} = "16:9";
        } elsif ($special =~ m/En 4:3/) {
            $prog{video}{aspect} = "4:3";
        } elsif ($special =~ m/HD/) {
            $prog{video}{quality} = "HDTV";
        } elsif ($special =~ m/Tous publics/) {
            $rating2 = 1;
        }

    }

    if(($episode ne "-1") || ($season ne "-1")) {
        if ($season ne "-1") {
        $epstring = ($season - 1);
        } else {
        $epstring = 0;
        }
        $epstring .= ".";
        if ($episode ne "-1") {
            if($episode =~ /(\d+)\/(\d+)/) {
                if($2) {
                    $epstring .= ($1-1)."/".$2;
                } else {
                $epstring .= ($1-1);
                }
            }
        }
        $epstring .= ".";
        push @{$prog{'episode-num'}}, [$epstring,"xmltv_ns"];
    }

    push @{$prog{icon}}, {src => $imgurl};

    if (defined $subgenre) {
        $prog{category} = [ [ xmlencoding(lc($genre)), $LANG ], [ xmlencoding(lc($subgenre)), $LANG ] ];
    }


    if ( $description ne "" ) {
        if($critic) {
            $description = $description." --  Critique : ".$critic;
        }
        push @{$prog{desc}}, [$description, $LANG ];
    }
    #$prog{showview}=$showview;


    my $icon;
    if ($age > 0 && !$rating2) {
        if ($age <= 10) {
            $icon = 'http://www.csa.fr/picts/visuels/picto_cat2.gif';
        } elsif ($age <= 12) {
            $icon = 'http://www.csa.fr/picts/visuels/picto_cat3.gif';
        } elsif ($age <= 16)  {
            $icon = 'http://www.csa.fr/picts/visuels/picto_cat4.gif';
        } else {
            $icon = 'http://www.csa.fr/picts/visuels/picto_cat5.gif';
        }
        $age = -$age;
#       $prog{rating} = [[ $age ]];
#       push @{$prog->{rating}}, [ $rating, "CSA", [ {src => $icon} ] ];
        if ($icon) {
            push @{$prog{rating}}, [ $age, "CSA", [ {src => $icon}] ];
        } else {
            push @{$prog{rating}}, [ $age, "CSA", [] ];
        }
    }
    else {
        push @{$prog{rating}}, [ "Tout public", "CSA", [] ];

    }

    # étoiles
    $prog{'star-rating'} = [$stars] if ($stars);


    $writer->write_programme(\%prog);

 }
 undef $page;
}

# use an integrated sub to set a specific user agent
sub get_page( $ ) {
    my $url = shift;

    if (defined $last_get_time) {
        # A page has already been retrieved recently.  See if we need
        # to sleep for a while before getting the next page - being
        # nice to the server.

        my $next_get_time = $last_get_time + (rand $Delay);
        my $sleep_time = $next_get_time - time();
        sleep $sleep_time if $sleep_time > 0;
    }

    my $r = $ua->get($url);

    # Then start the delay from this time on the next fetch - so we
    # make the gap _between_ requests rather than from the start of
    # one request to the start of the next.  This punishes modem users
    # whose individual requests take longer, but it also punishes
    # downloads that take a long time for other reasons (large file,
    # slow server) so it's about right.

    $last_get_time = time();

    if ($r->is_error) {
        # At the moment download failures seem rare, so the script dies if
        # any page cannot be fetched.  We could later change this routine
        # to return undef on failure.  But dying here makes sure that a
        # failed page fetch doesn't get stored in XMLTV::Memoize's cache.
        #
        die "could not fetch $url, error: " . $r->status_line . ", aborting\n" if $FailOnError;
        $errors{$url} = $r->status_line;
        return undef;
    } else {
         print STDERR "Récupération de ".$url."\n";
        return $r->content;
    }

}