xmltv-util 0.5.67-0.1 / usr / bin / tv_grab_pt

#!/usr/bin/perl

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

=pod

=head1 NAME

tv_grab_pt - Grab TV listings for Portugal.

=head1 SYNOPSIS

tv_grab_pt --help

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

tv_grab_pt [--config-file FILE] [--output FILE] [--days N]
           [--offset N] [--fast] [--quiet] [--icons]

tv_grab_pt --list-channels

=head1 DESCRIPTION

Output TV listings for several channels available in Portugal.
It supports the public network and the private NetCabo network.

First run B<tv_grab_pt --configure> to choose, which channels you want
to download. Then running B<tv_grab_pt> with no arguments will output
listings in XML format to standard output.

B<--configure> Prompt for which channels,
and write the configuration file.

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

B<--days N> Grab N days.  The default is 7 days.

B<--offset N> Start N days in the future.  The default is to start
from today.

B<--fast> Only fetch summary information for each programme. This is
only title, start/stop times, category, episode number.

B<--output FILE> Write to FILE rather than standard output.

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

B<--icons> Fetches channels icons/logos [deprecated - this is now the default]

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

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

=head1 SEE ALSO

L<xmltv(5)>.

=head1 AUTHOR

Bruno Tavares, gawen@users.sourceforge.net, based on tv_grab_es, from Ramon Roca.

Grabber Site : http://bat.is-a-geek.com/XMLGrabPt

=head1 BUGS

=cut

######################################################################
# initializations

use warnings;
use strict;
use XMLTV::Version '$Id: tv_grab_pt,v 1.57 2015/08/10 10:41:00 bilbo_uk Exp $ ';
use XMLTV::Capabilities qw/baseline manualconfig cache/;
use XMLTV::Description 'Portugal';
use Getopt::Long;
#use Date::Manip;
use DateTime;
#use Data::Dumper;
use HTML::TreeBuilder;
use HTML::Entities; # parse entities
use HTTP::Cache::Transparent;
use Encode;
use IO::File;
use File::Path;
use File::Basename;
#use LWP::UserAgent;

use XMLTV;
use XMLTV::Memoize;
use XMLTV::ProgressBar;
use XMLTV::Ask;
use XMLTV::Config_file;
use XMLTV::DST;
use XMLTV::Get_nice 0.005067;
use XMLTV::Mode;
# Todo: perhaps we should internationalize messages and docs?
use XMLTV::Usage <<END
$0: get Portuguese television listings in XMLTV format
To configure: $0 --configure [--config-file FILE] [--gui OPTION]
To grab listings: $0 [--config-file FILE] [--output FILE] [--quiet] [--offset OFFSET] [--days DAYS] [--icons]
To list channels: $0 --list-channels
END
  ;

my $DOMAIN = 'nos.pt';
my $SOURCE_URL = "http://www.$DOMAIN";

# Attributes of the root element in output.
my $HEAD = { 'source-info-url'     => "http://$DOMAIN/",
             'source-data-url'     => "http://www.$DOMAIN/particulares/televisao/guia-tv/",
             'generator-info-name' => 'XMLTV',
             'generator-info-url'  => 'http://xmltv.org/',
           };

# default language
my $LANG="pt";

# Global channel_data
our @ch_all;

######################################################################
# get options

# Get options, including undocumented --cache option.
XMLTV::Memoize::check_argv('XMLTV::Get_nice::get_nice_aux');
our ($opt_help, $opt_output,
    $opt_configure, $opt_config_file, $opt_gui, $opt_quiet,
    $opt_list_channels, $opt_offset, $opt_days, $opt_fast, $opt_icons,
    $opt_debug);
$opt_quiet  = 0; # default
$opt_days   = 7; # default
$opt_offset = 0; # default
$opt_fast   = 0; # default
$opt_debug  = 0;
GetOptions('help'          => \$opt_help,
           'configure'     => \$opt_configure,
           'config-file=s' => \$opt_config_file,
           'gui:s'         => \$opt_gui,
           'output=s'      => \$opt_output,
           'quiet'         => \$opt_quiet,
           'list-channels' => \$opt_list_channels,
           'offset=i'      => \$opt_offset,
           'days=i'        => \$opt_days,
           'fast'          => \$opt_fast,
           'icons'         => \$opt_icons,         # Fetches channels icons/logos [deprecated - this is now the default]
           'debug'         => \$opt_debug,         # undocumented
          )
  or usage(0);
usage(1) if $opt_help;

# Initialise the web page cache
HTTP::Cache::Transparent::init( {
    BasePath => get_default_cachedir(),
    NoUpdate => 4*3600,         # cache time in seconds
    MaxAge   => 24,               # flush time in hours
    Verbose  => $opt_debug,
} );
##$XMLTV::Get_nice::Delay = 0 if $opt_debug;

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


our $first_day = ($opt_offset || 0);
our $last_day  = $first_day + $opt_days;
die 'cannot grab more than one week ahead' if $first_day >= 7 || $last_day > 7;

my $mode = XMLTV::Mode::mode('grab', # default
                             $opt_configure => 'configure',
                             $opt_list_channels => 'list-channels',
                            );

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

my @config_lines; # used only in grab mode
if ($mode eq 'configure') {
    XMLTV::Config_file::check_no_overwrite($config_file);
    mkpath(dirname($config_file));
}
elsif ($mode eq 'grab') {
    @config_lines = XMLTV::Config_file::read_lines($config_file);
}
elsif ($mode eq 'list-channels') {
    # Config file not used.
}
else { die }

# Whatever we are doing, we need the channels data.
my $token;
my %channels = get_channels(); # sets @ch_all
my %channelnumbers;
my @channels;

my %icons = ();
%icons = get_icons() if $opt_icons;


######################################################################
# write configuration

if ($mode eq 'configure') {
    open(CONF, ">$config_file") or die "cannot write to $config_file: $!";

    # Ask about each channel.
    my @chs = sort keys %channels;
    my @names = map { $channels{$_}->{'channel-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;
        # No need to print to user - XMLTV::Ask is verbose enough.

        # Print a config line, but comment it out if channel not wanted.
        print CONF '#' if not $w;
        my $name = shift @names;
        print CONF "channel $_.$DOMAIN\n";
    }

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

    exit();
}


# Not configuration, we must be writing something, either full
# listings or just channels.
#
die if $mode ne 'grab' and $mode ne 'list-channels';

# Options to be used for XMLTV::Writer.
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;
sub start_writing() { ($writer = new XMLTV::Writer(%w_args))->start($HEAD) }

if ($mode eq 'list-channels') {
    start_writing;
    foreach (@ch_all) {
        $_{'icon'} = [{'src' => $icons{$_}}] if(defined($icons{$_}));
    }
    $writer->write_channel($_) foreach @ch_all;
    $writer->end();
    exit();
}

######################################################################
# We are producing full listings.
die if $mode ne 'grab';

# Read configuration
my $line_num = 1;
foreach (@config_lines) {
    ++$line_num;
    next if not defined;

    # For now, check that $DOMAIN appears on every line.  This
    # ensures we don't have a config file left over from the old
    # grabber.
    #
    if (/^channel:?\s+(.+)\.nos\.pt\s*$/) {
        my $ch_did = $1;
        die if not defined $ch_did;
        push @channels, $ch_did;
    }
    elsif (/^channel:?\s+(.+)\.tvcabo\.pt\s*$/) {
        # old site but has same channel numbers
        my $ch_did = $1;
        die if not defined $ch_did;
        push @channels, $ch_did;
    }
    elsif (/^channel/) {
        die <<END
The configuration file is left over from the old tv_grab_pt.  The new
site uses different channels so you need to reconfigure the grabber.
END
          ;
    }
    else {
        warn "$config_file:$line_num: bad line\n";
    }
}

######################################################################
# begin main program

start_writing;

# Assume the listings source uses CET (see BUGS above).
die "No channels specified, run me with --configure\n"
  if not keys %channels;
my @to_get;

# the order in which we fetch the channels matters
# This progress bar is for both downloading and parsing.  Maybe
# they could be separate.
#

my $bar = new XMLTV::ProgressBar('getting listings', scalar @channels)
  if not $opt_quiet;

# write the <channels> elements
foreach my $ch_did (@channels) {
    die if not defined $ch_did;

    my $ch_name=$channels{$ch_did}->{'channel-name'};
    my $channel = { 'id'           => $channels{$ch_did}->{'id'},
                    'display-name' => $channels{$ch_did}->{'display-name'},
                    'icon'         => $channels{$ch_did}->{'icon'},
    };
    $channel->{'icon'} = [{'src' => $icons{$ch_did}}] if(defined($icons{$ch_did}));

    $writer->write_channel($channel);
}


# time limits for grab
my $today_date = DateTime->today(time_zone => 'Europe/Lisbon');
my $grab_start = $today_date->epoch() + ($opt_offset * 86400);
my $grab_stop  = $grab_start + ($opt_days * 86400);
print STDERR "\n start/end grab: $grab_start $grab_stop \n" if $opt_debug;

my $some=0;
foreach my $ch_did (@channels) {
    #skip legacy channels...
    next unless $channels{$ch_did};
    foreach (process_table($ch_did)) {
        $writer->write_programme($_);
        $some = 1;
    }
    update $bar if $bar;
}
if (not $some) {
  die "no programmes found\n" unless $some;
}

$writer->end();

######################################################################
# subroutine definitions

# 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();
    }
}

# Clean up bad characters in HTML.
sub _tidy( $ ) {
    for (my $s = shift) {
        # Character 150 seems to be used for 'versus' in sporting
        # events, but I don't know what that is in Portuguese.
        #
        #s/\s\226\s/ vs /g;
        return $_;
    }
}

# Remove bad chars from an element
sub tidy( $ ) {
    return $_[0] if !defined $_[0];
    $_[0] =~ s/(\s)\xA0/$1/og;    # replace 'space-&nbsp;' with 'space'
    $_[0] =~ s/\xA0/ /og;         # replace any remaining &nbsp; with space
    $_[0] =~ s/\xAD//og;          # delete soft hyphens
    return $_[0];
}

# Wrapper around Encode (and fix_utf8)
sub toUTF8( $ )  {
    return fix_utf8( Encode::encode("utf-8", $_[0]) );
}

# UTF-8 fixups.
sub fix_utf8( $ ) {
    #  The details page claims to be utf-8 but there are some invalid characters in the incoming data
    #  e.g. it claims en-dash as C2 96 (which is a control code in utf-8!)
    #  Looks like an improper conversion from Windows-1252 in the source data
    #
    return $_[0] if !defined $_[0];
    $_[0] =~ s/\xC2\x96/\xE2\x80\x93/og;      # replace invalid en-dash with correct value
    $_[0] =~ s/\xC2\x80/\xE2\x82\xAC/og;      # euro
    $_[0] =~ s/\xC2\x85/\xE2\x80\xA6/og;      # ellipsis
    $_[0] =~ s/\xC2\x92/\xE2\x80\x99/og;      # apostrophe
    $_[0] =~ s/\xC2\x93/\xE2\x80\x9C/og;      # open double quote
    $_[0] =~ s/\xC2\x94/\xE2\x80\x9D/og;      # close double quote
    $_[0] =~ s/\xC2[\x80-\x9F]//og;           # dump the rest
    return $_[0];
}

# Remove leading & trailing spaces
sub trim( $ ) {
    # Remove leading & trailing spaces
    $_[0] =~ s/^\s+|\s+$//g;
    return $_[0];
}

sub process_table {
    my ($ch_xmltv_id) = @_;

    t "Getting channel $ch_xmltv_id\n";

    $ch_xmltv_id =~ /(.+?)\.zon\.pt/;

    # This seems like a useful link but I can't see how to get the channelindex
    #   http://www.zon.pt/_layouts/EPGGetProgramsForChannels.aspx?cIndex=1&day=1&order=grelha&category=&numChannels=1

    # http://www.zon.pt/tv/guiaTV/Pages/Guia-TV-programacao.aspx?channelSigla=5
    # 2014-05-19  http://www.nos.pt/particulares/televisao/guia-tv/Pages/channel.aspx?channel=5
    #
    my $url = $HEAD->{'source-data-url'} . 'Pages/channel.aspx?channel='.$ch_xmltv_id;
    print STDERR " URL= $url \n" if $opt_debug;
    t $url;

    my $tree  = get_nice_tree($url, '', 'UTF-8');

    my $programmes = {};
    my $firstdaynum;

    if ( my $h = $tree->look_down('_tag' => 'div', 'id' => 'programs-container') ) {
        if ( my @h2 = $h->look_down('_tag' => 'div', 'class' => qr/programs-day-list/) ) {
            DAY:
            foreach my $h_day (@h2) { # schedule for a day
                my ($daynum) = $h_day->attr('id') =~ /day(\d*)/;
                $firstdaynum = $daynum if !defined $firstdaynum;

                my $dt = $today_date->clone()->set_day($daynum);
                $dt->add( months => 1 )  if $daynum < $firstdaynum;
                #print STDERR "\n" . $dt->strftime("%Y%m%d%H%M%S %z") . "\n";

                next DAY if $dt->epoch() < $grab_start || $dt->epoch() >= $grab_stop;

                if ( my @h3 = $h_day->look_down('_tag' => 'li') ) { # progs for a day
                    my $j = 0;
                    PROG:
                    foreach my $h_prog (@h3) { # each prog
                        $j++;

                        #<li style="height:119px;">
                        #    <span style="height:55px">
                        #        <a class="series" id="71841" href="#" title="Anatomia de Grey T.9 Ep.22">
                        #            <span class="program">Anatomia de Grey T.9 Ep.22</span><br>
                        #            <span class="duration">02:19 - 03:03</span>
                        #        </a>
                        #    </span>
                        #</li>

                        my ( $p_id, $p_category, $p_title, $p_desc, $p_timespan, $p_start, $p_stop, $p_start_epoch, $p_stop_epoch, $p_episode_num );

                        if ( my $a = $h_prog->look_down('_tag' => 'a') ) {
                            $p_category = $a->attr('class');
                            $p_id = $a->attr('id');
                            $p_title = $a->attr('title');

                            if ( my $s = $a->look_down('_tag' => 'span', 'class' => 'program') ) {
                                $p_desc = tidy $s->as_text();
                            }

                            if ( my $s = $a->look_down('_tag' => 'span', 'class' => 'duration') ) {
                                my ($start_h, $start_m, $stop_h, $stop_m) = $s->as_text() =~ /(\d\d):(\d\d)\s-\s(\d\d):(\d\d)/;

                                my $start = $dt->clone();  $start->set( 'hour' => $start_h, 'minute' => $start_m );
                                my $stop  = $dt->clone();  $stop->set ( 'hour' => $stop_h,  'minute' => $stop_m  );

                                if ($stop_h < $start_h) {  # stop hh < start hh = assume we've gone to the next (or previous) day
                                    $start->subtract( days => 1 ) if $j == 1;    # first programme in day
                                    $stop->add( days => 1 )       if $j != 1;    # not first programme in day
                                }

                                $p_start = $start->strftime("%Y%m%d%H%M%S %z");
                                $p_stop  = $stop->strftime("%Y%m%d%H%M%S %z");
                                $p_start_epoch = $start->epoch();
                                $p_stop_epoch  = $stop->epoch();
                                $p_timespan = $s->as_text();
                            }


                            # strip the SnnEnn out of the title (e.g. "Anatomia de Grey T.9 Ep.24")
                            my ($p_ser, $p_ep) = ('', '');  my $p_match;
                            if ( ($p_match, $p_ser, $p_ep) = $p_title =~ /.*(T\.(\d*)\sEp\.(\d*))/ ) {
                                $p_episode_num = --$p_ser . ' . ' . --$p_ep . ' . ';
                            } elsif ( ($p_match, $p_ep) = $p_title =~ /.*(Ep\.(\d*))/ ) {
                                $p_episode_num = ' . ' . --$p_ep . ' . ';
                            }
                            $p_title =~ s/$p_match//  if $p_match;
                            trim $p_title;
                        }

                        next PROG if $p_start_epoch < $grab_start || $p_start_epoch >= $grab_stop;

                        my %prog;
                        $prog{'channel'}     = "$ch_xmltv_id.$DOMAIN";
                        $prog{'id'}          = $p_id;
                        $prog{'title'}       = $p_title;
                        $prog{'category'}    = $p_category;
                        $prog{'start'}       = $p_start;
                        $prog{'stop'}        = $p_stop;
                        $prog{'episode-num'} = $p_episode_num;
                        $prog{'timespan'}    = $p_timespan;        # not an xmltv item: used in process_details_page()

                        # if user wants details then get them from the programme page
                        if (!$opt_fast) {
                            process_details_page ( $ch_xmltv_id, \%prog, $tree );
                        }

                        # store the programme avoiding duplicates
                        # also check for duplicate start times and set clumpidx
                        {
                            if ( defined $programmes->{ $ch_xmltv_id }->{ $p_start_epoch } ) {
                                # duplicate prog or contemporary?
                                my $dup = 0; my $_P;
                                foreach $_P ( @{ $programmes->{ $ch_xmltv_id }->{ $p_start_epoch } } ) {
                                    $dup = 1  if ( $_P->{'title'} eq $prog{'title'} );    # duplicate
                                }
                                next PROG if $dup;    # ignore duplicates (go to next programme)
                                if (!$dup) {
                                    # contemporary programme so set clumpidx
                                    my $numclumps = scalar @{ $programmes->{ $ch_xmltv_id }->{ $p_start_epoch } }  + 1;
                                    # set (or adjust) clumpidx of existing programmes
                                    my $i = 0;
                                    foreach $_P ( @{ $programmes->{ $ch_xmltv_id }->{ $p_start_epoch } } ) {
                                        $_P->{'clumpidx'} = "$i/$numclumps";
                                        $i++;
                                    }
                                    # set clumpidx for new programme
                                    $prog{'clumpidx'} = "$i/$numclumps";
                                }
                            }
                        }

                        # store the programme
                        push @{ $programmes->{ $ch_xmltv_id }->{ $p_start_epoch } }, \%prog;

                    } # end each prog
                } # end progs for each day
            } # schedule for a day
        } # programs-day-list
    } # programs-container


    # did we get any programmes?
    if ( scalar $programmes == 0 ) {
            warn "$url ($ch_xmltv_id) : no programmes found\n";
        return;
    }

    # format the programmes ready for XMLTV::Writer
    my @r;
    foreach ( keys %{$programmes} ) {
        my $_ch_progs = $programmes->{$_};
        foreach ( sort keys %{$_ch_progs} ) {
            my $_dt_progs = $_ch_progs->{$_};
            foreach (@{ $_dt_progs }) {
                push @r, make_programme_hash( $ch_xmltv_id, $_ );
             }
        }
    }
    return @r;
}

sub process_details_page {
    my ($ch_xmltv_id, $prog, $s_tree) = @_;

    t "Getting prog details $$prog{'id'} \n";

    my $channelAcronym1;
    if ( my $h = $s_tree->look_down('_tag' => 'div', 'id' => 'channel-logo') ) {
        if ( my $h2 = $h->look_down('_tag' => 'img') ) {
            $channelAcronym1 = $h2->attr('alt');
        }
    }
    my $HoursToAddOrRemove = 0;
    if ( my $h = $s_tree->look_down('_tag' => 'input', 'id' => 'ctl00_PlaceHolderMain_channelProgr_HoursToAddOrRemove') ) {
        $HoursToAddOrRemove = $h->attr('value');
    }
    my $programId1 = $$prog{'id'};
    my ($timespan) = $$prog{'timespan'} =~ s/ /%20/g;
    my @substr = split(/-/, $$prog{'timespan'});

    my $url = $HEAD->{'source-info-url'} . '_layouts/15/Armstrong/ApplicationPages/EPGGetProgramsAndDetails.aspx/GetProgramDetails';
    print STDERR " URL= $url \n" if $opt_debug;
    t $url;

    my $json = "{ 'programId':'$programId1', 'channelAcronym':'$channelAcronym1', 'hour':'$HoursToAddOrRemove', 'startHour':'$substr[0]', 'endHour':'$substr[1]' }";


    # This is what the page returns. Looks like an old school delimited list
    #    (c.f. OnCallGetProgramDetailsComplete JS code)
    #
    #    Anatomia de Grey T.9 Ep.23_#|$_O drama médico mais famoso da televisão centra a sua história nas vidas profissionais e pessoais de um grupo de médicos cirurgiões e dos seus supervisores._#|$_277055_resized_352x198.jpg_#|$_02:47 _#|$_ 03:28_#|$_RTP 1_#|$_2014-05-07T02:47:00+01:00_#|$_2014-05-07T03:28:00+01:00_#|$_false
    #

    # Emulate an AJAX post for the requested content
    my $content = post_nice_json($url, $json);
    my @data = split(/_#\|\$_/, $content->{'d'});

    # We could check the title matches what we already have but why not just trust the 'id' is correct ;-)

    $$prog{'desc'} = tidy $data[1];        # store the description in our prog hash
    $$prog{'icon'} = "http://images.$DOMAIN/" . $data[2];        # [2] is a uri to the programme image

    return;
}


# reformat the data to something acceptable to xmltv:::writer
sub make_programme_hash {
    my ( $ch_xmltv_id, $cur ) = @_;

    my %prog;

    $prog{channel} = $cur->{'channel'};

    #$prog{channel} =~ s/\s/_/g;

    $prog{'title'} = [ [ toUTF8( $cur->{'title'} ), $LANG ] ];
    $prog{'sub-title'} = [ [ toUTF8( $cur->{'subtitle'} ), $LANG ] ] if $cur->{'subtitle'};
    $prog{'category'} = [ [ toUTF8( $cur->{'category'} ), $LANG ] ] if $cur->{'category'};
    $prog{'episode-num'} = [[ $cur->{'episode-num'}, 'xmltv_ns' ]] if $cur->{'episode-num'};
    $prog{'start'} = $cur->{'start'} if $cur->{'start'};
    $prog{'stop'} = $cur->{'stop'} if $cur->{'stop'};
    $prog{'desc'} = [ [ toUTF8( $cur->{'desc'} ), $LANG ] ] if $cur->{'desc'};
    $prog{'icon'} = [ { 'src' => $cur->{'icon'} } ] if $cur->{'icon'};
    $prog{'credits'} = $cur->{'credits'} if $cur->{'credits'};
    $prog{'date'}    = $cur->{'year'}    if $cur->{'year'};

    return \%prog;
}

# get channel listing
sub get_channels {
    my $bar = new XMLTV::ProgressBar( 'getting list of channels', 1 )  if not $opt_quiet;
    my %channels;

    # retrieve channels via a dummy call to the schedule page
    #   http://www.zon.pt/tv/guiaTV/Pages/GuiaTV.aspx
    #  2014-05-19  http://www.nos.pt/particulares/televisao/guia-tv/Pages/default.aspx
    my $url = $HEAD->{'source-data-url'} . 'Pages/default.aspx';
    t $url;

    my $tree  = get_nice_tree($url, '', 'UTF-8');

    #  <div id="channels-list-container">
    #    <ul id="channels-list-slider">
    #        <li>
    #            <span class="channel-number">001</span>
    #            <span class="channel-logo">
    #                <a href='/tv/guiaTV/Pages/Guia-TV-programacao.aspx?channelSigla=5' title='RTP 1'>
    #                    <img src='/EPGChannelImages/RTP1.png' alt='logótipo RTP 1' />
    #                </a>
    #            </span>
    #        </li>
    #  2014-05-19
    #        <li>
    #            <span class="channel-logo">
    #                <a href="/particulares/televisao/guia-tv/Pages/channel.aspx?channel=5" title="RTP 1">
    #                    <img src="//images.nos.pt/EPGChannelImages/RTP1.png" alt="logótipo RTP 1">
    #                </a>
    #            </span>
    #            <span class="channel-number">001</span>
    #        </li>
    #    http://images.nos.pt/EPGChannelImages/RTP1.png
    #
    if ( my $h = $tree->look_down('_tag' => 'div', 'id' => 'channels-list-container') ) {
        if ( my $h2 = $h->look_down('_tag' => 'ul', 'id' => 'channels-list-slider') ) {
            my @h3 = $h2->look_down('_tag' => 'li');
            foreach my $elem (@h3) {
                my ($channel_id, $channel_name, $channel_logo);
                if ( my $h4 = $elem->look_down('_tag' => 'a') ) {
                    $channel_name = toUTF8( $h4->attr('title') );
                    ($channel_id) = $h4->attr('href') =~ /channel=(\d*)/;
                }
                if ( my $h4 = $elem->look_down('_tag' => 'img') ) {
                    $channel_logo = 'http:' . $h4->attr('src');
                }
                # store the channel
                my $ch =
              {
                'channel-name'  => $channel_name,
                'display-name'  => [ [ $channel_name, $LANG ] ],
                'id'            => $channel_id.'.'.$DOMAIN,
                'icon'          => [ { 'src' => $channel_logo } ],
              };
                $channels{$channel_id} = $ch;
                push @ch_all, $ch;

            } #foreach
        }
    }
    die "no channels could be found" if not keys %channels;

    update $bar if not $opt_quiet;
    $tree->delete;
    return %channels;
}

sub nextday {
    my $d = shift;
    my $p = ParseDate($d);
    my $n = DateCalc($p, '+ 1 day');
    return UnixDate($n, '%Q');
}

sub get_icons { # deprecated
    my %icons;
    my $url= $HEAD->{"source-info-url"}."/Televisao/ListaProgramas.aspx?dia=0&package=9&cat=&channelSigla=";
    my $chan;
    my $tag;
    my $addr;

    my $bar = new XMLTV::ProgressBar('grabbing icons', scalar(keys(%channels)))
      if not $opt_quiet;

    foreach (keys %channels) {
        my $tb = get_nice_tree $url.encode_entities($_), \&tidy;

        $tag = $tb->look_down('_tag' => 'img',
        sub {
            return ($_[0]->attr('src') =~ m/Shared\/img\/televisao\/BackofficeImages\//);
        });
        update $bar if not $opt_quiet;

        unless(ref($tag) eq "HTML::Element") {
                $tb->delete;
                next;
        };

        $icons{$_} = $tag->attr('src');
        $icons{$_} =~ s/\.\./$HEAD->{'source-info-url'}/;

        $tb->delete;
    }
    $bar->finish() if not $opt_quiet;

    return %icons;
}


# Get the user's home directory
sub get_default_dir {
    my $winhome = $ENV{HOMEDRIVE} . $ENV{HOMEPATH}
            if defined( $ENV{HOMEDRIVE} ) and defined( $ENV{HOMEPATH} );

    my $home = $ENV{HOME} || $winhome || ".";
    return $home;
}

# Set default cache dir = $HOME/.xmltv/cache
sub get_default_cachedir {
    return get_default_dir() . "/.xmltv/cache";
}