#!/usr/bin/perl

=pod

=encoding utf8

=head1 NAME

tv_grab_pt_vodafone - Grab TV listings for Vodafone in Portugal

=head1 SYNOPSIS

tv_grab_pt_vodafone --help

tv_grab_pt_vodafone --configure [--config-file FILE]

tv_grab_pt_vodafone [--config-file FILE]
                    [--days N] [--offset N] [--channel xmltvid,xmltvid,...]
                    [--output FILE] [--quiet | --debug]

tv_grab_pt_vodafone --list-channels [--config-file FILE]
                    [--output FILE] [--quiet | --debug]


=head1 DESCRIPTION

Output TV listings in XMLTV format for many stations available in Portugal.
This program consumes the EPG service from L<https://vodafone.pt/>.

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

Then running B<tv_grab_pt_vodafone> with no arguments will get listings for
the stations you chose for the maximum 7 days, including today.

=head1 OPTIONS

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

B<--config-file FILE> Set the name of the configuration file, the
default is B<~/.xmltv/tv_grab_pt_vodafone.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 everything available.

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

B<--quiet> Only print error-messages on STDERR.

B<--debug> Provide more information on progress to STDERR to help in
debugging.

B<--list-channels> Output a list of all channels that data is available for.
The list is in xmltv-format.

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

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

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

=head1 ERROR HANDLING

If the grabber fails to download data from Vodafone, it will print an
error message to STDERR and then exit with a status code of 1 to indicate
that the data is missing.

=head1 ENVIRONMENT VARIABLES

The environment variable HOME can be set to change where configuration
files are stored. All configuration is stored in $HOME/.xmltv/. On Windows,
it might be necessary to set HOME to a path without spaces in it.

=head1 CREDITS

Kevin Groeneveld (kgroeneveld at gmail dot com)

This grabber uses code from tv_grab_pt_meo by Karl Dietz, dekarl -at- users -dot- sourceforge -dot- net,
and from tv_grab_zz_sdjson by Kevin Groeneveld, kgroeneveld -at- gmail -dot- com.

The original idea of this grabber came from higuita's shell script, see
L<https://github.com/higuita/vodafone.pt-xmltv>.

Special thanks to Vodafone for building a clean, fast, and public access API;
much more reliable than Meo's open API (but sadly not as open) and much better
than the lack of any API from NOS.

=head1 AUTHOR

Nuno Sénica, nsenica -at- gmail -dot- com.

=head1 BUGS

None known.

=cut

use warnings;
use strict;
use utf8;
use XMLTV;
use XMLTV::Version "$XMLTV::VERSION";
use DateTime;
use Encode; # used to convert 'perl strings' into 'utf-8 strings'
use XML::LibXML;
use XMLTV::Configure::Writer;
use XMLTV::Get_nice qw/get_nice/;
use XMLTV::Options qw/ParseOptions/;
use XMLTV::Supplement qw/GetSupplement/;
use JSON;
use Text::Unidecode;
use URI::Escape qw/ uri_escape /;
use URI::Encode qw/ uri_encode uri_decode/;
# use Data::Dump qw/pp/; # uncomment to debug

my $maxdays = 1+6; # data source is limited to 7 days (including today)

my $grabber_name = 'tv_grab_pt_vodafone';
my $grabber_version = '3.00';

my $json_baseurl = 'https://cdn.pt.vtv.vodafone.com/epg/';

# Generate with:
# jq -r '.channels[]|(.epgId,.title,.logo.color.uri)' channel.list.new | sed 'N;N; s/\n/\t/g' | sort > channel.list
my $channel_list_file = 'channel.list';

my $ua = LWP::UserAgent->new(ssl_opts => {
    SSL_cipher_list => 'DEFAULT:!DH',
});
$ua->agent("$grabber_name $grabber_version");
$ua->default_header('accept-encoding' => scalar HTTP::Message::decodable());

my( $opt, $conf ) = ParseOptions( {
    grabber_name => $grabber_name,
    capabilities => [qw/apiconfig baseline manualconfig preferredmethod/],
    listchannels_sub => \&list_channels,
    stage_sub => \&config_stage,
    version => "$XMLTV::VERSION",
    description => "Portugal (Vodafone)",
    preferredmethod => 'allatonce',
    defaults => { days => $maxdays, offset => 0, quiet => 0, debug => 0 },
} );

# limit to maxdays in the future
if ($opt->{offset} + $opt->{days} > $maxdays) {
    $opt->{days} = $maxdays - $opt->{offset};
}

# Get the actual data and print it to stdout.
my $is_success=1;

my $startDate = DateTime->from_epoch( epoch => time () );
$startDate->set_time_zone( 'Europe/Lisbon' );
$startDate->truncate( to => 'day' );
$startDate->add( days => $opt->{offset} );
my $endDate=$startDate->clone()->add( days => $opt->{days} );
$endDate->add( seconds => -1 );

my %w_args = (
    cutoff => '000000',
    days => $opt->{days},
    encoding => 'UTF-8',
    offset => $opt->{offset},
);

my $writer = new XMLTV::Writer( %w_args );

$writer->start({
    'generator-info-name' => "XMLTV/".$opt->{version},
    'generator-info-url' => 'http://www.xmltv.org/',
    'source-info-name' => 'EPG Service for Vodafone',
    'source-info-url' => $json_baseurl,
});

if ( ! undef $opt->{days} ) {
    if( !$opt->{quiet} ) {
        print( STDERR "fetching data\n" );
    }
    get_epg( $writer, $startDate, $endDate );
} else {
    if( !$opt->{quiet} ) {
        print( STDERR "no data available for the requested time period\n" );
    }
    $is_success = 0;
}


$writer->end();

if( $is_success ) {
    exit 0;
} else {
    exit 1;
}

sub config_stage
{
    my( $stage, $conf ) = @_;
    die "Unknown stage $stage" if $stage ne "start";

    my $result;
    my $writer = new XMLTV::Configure::Writer( OUTPUT => \$result, encoding => 'utf-8' );
    $writer->start( { grabber => 'tv_grab_pt_vodafone' } );
    $writer->end( 'select-channels' );

    return $result;
}

sub list_channels 
{
    my ( $conf, $opt ) = @_;

    my $channellist = _read_channel_data();

    my $output=XML::LibXML::Document->new( '1.0', 'utf-8' );
    my $root=XML::LibXML::Element->new( 'tv' );
    $output->setDocumentElement( $root );

    foreach my $key ( sort keys %$channellist ) {
        my $channel=$channellist->{$key};
        my $sigla=$key;
        my $name=$channel->{name};
        my $icon=$channel->{icon};
        my $tmp=XML::LibXML::Element->new( 'channel' );
        $tmp->setAttribute( 'id', encode( 'UTF-8', $sigla ) );
        $tmp->appendTextChild( 'display-name', encode( 'UTF-8', $name ) );
        my $iconElement=XML::LibXML::Element->new( 'icon' );
        $iconElement->setAttribute( 'src', $icon );
        $tmp->appendChild( $iconElement );
        $root->appendChild( $tmp );
    }

    return $output->toString();

}

sub _read_channel_data
{
    my $channel_list = {};
    my $c = 0;
    my $channel_list_str = GetSupplement( 'tv_grab_pt_vodafone', $channel_list_file );
    foreach my $channel_string (split( /\n/, $channel_list_str )) {
        chomp($channel_string);
        # remove commented channels
        $channel_string =~ s/^#.*//;
        next if not length $channel_string;
        my @items = split("\t",$channel_string);
        $items[1] =~ s/\"//g;
        $channel_list->{ $items[0] } = {
            name => decode('UTF-8', $items[1]),
            icon => $items[2]
        };
    }

    return $channel_list
}


sub get_epg
{
    my( $writer, $startDate, $endDate ) = @_;

    my @channelList = @{$conf->{channel}};

    my %xmlchannels;
    my %xmlprogs;

    my $curDate = $startDate;

    my $channelInfo = _read_channel_data();

    while ( $curDate <=  $endDate ) {

        for my $channel (@channelList) {

            my $channelId = make_channelid( $channelInfo->{$channel}->{name} );
            my %ch = (
                'id' => $channelId,
                'icon' => [ { src =>  unquote($channelInfo->{$channel}->{icon}) } ],
            );
            # multiple display-names are ok and may be useful to match other tools lists
            my @displayname = ( [  sanitizeUTF8( $channelInfo->{$channel}->{name} ), 'pt' ] ,
                                [  sanitizeUTF8( $channelId ), 'pt' ] ,
                                [  sanitizeUTF8( $channel ), 'pt' ] );

            push @{ $ch{'display-name'} }, @displayname ;

            $xmlchannels{ $channelId } = \%ch ;

            my $date_day = $curDate->strftime('%d');
            my $date_month = $curDate->strftime('%m');
            my $date_year = $curDate->year;

            for my $period ("00-06","06-12","12-18","18-00") {

                print( STDERR "requesting EPG from " . $curDate->ymd() ." [".$period."]". " for " . $channelId . "\n" )  if( !$opt->{quiet} );
                print( STDERR " GET ".$json_baseurl.$channel."/".$date_year."/".$date_month."/".$date_day."/".$period."\n" )  if( $opt->{debug} );

                my $epgSource = json_request('get', $channel."/".$date_year."/".$date_month."/".$date_day."/".$period);

                if ( ! $epgSource ){
                    die("Bad EPG download, probably channel list is outdated, rerun the grabber configure to update the list.\n" ); }
                elsif ( !$epgSource->{result} || !$epgSource->{result}->{objects} || scalar @{$epgSource->{result}->{objects}} == 0 ){
                    print( STDERR " Empty EPG download for ".$channel.", probably channel list is outdated or no API data for that channel\n" .
                    "  Rerun the grabber configure to update the list or check for the channel EPG in the Vodafone app.\n" );
                    next;
                };

                my $data = $epgSource->{result}->{objects};

                PROGRAMME:
                for my $programme ( @{ $data }) {
                    my %prog;
                    my ($dtstart, $dtend, $starts_today) = make_dates($programme->{startDate}, $programme->{endDate}, $curDate);

                    $prog{start} = $dtstart;
                    $prog{stop} = $dtend;
                    $prog{channel} = $channelId;
                    $prog{title} = get_title($programme);
                    $prog{desc} = get_desc($programme); 
                    $prog{date} = get_date($programme);
                    $prog{'episode-num'} = make_episode_num($programme);

                    my $length = get_length($programme);
                    $prog{length} = $length if $length;

                    my $icon = get_icon($programme);
                    $prog{icon} = $icon if $icon;

                    my $category = get_category($programme);
                    $prog{category} = $category if $category;

                    my $country = get_country($programme);
                    $prog{country} = $country if $country;

                    my $rating = get_rating($programme);
                    $prog{rating} = $rating if $rating;

                    my $image = get_images($programme);
                    $prog{image} = $image if $image;

                    my $actors = get_actors($programme);
                    $prog{credits}{actor} = $actors if $actors;

                    my $directors = get_directors($programme);
                    $prog{credits}{director} = $directors if $directors;

                    # We can get the same programme for two different days if it goes past midnight.
                    # Lets remove duplicates here.
                    $xmlprogs{$channelId}{ $dtstart, $dtend } = \%prog;
                    print( STDERR "  Adding programme: " . $prog{title}[0][0] . " [" . $dtstart . " - " . $dtend . "]\n" )  if( $opt->{debug} );
                }
                
            }

        }

        $curDate->add(days => 1);
    }

    $writer->write_channel($_) for values %xmlchannels;
    for my $ch (keys %xmlchannels) {
        $writer->write_programme($_) for values %{ $xmlprogs{$ch} };
    }

    $is_success=1;
}

sub sanitizeUTF8 {
    my ($str) = @_;

    $str =~ s/[^[:print:]]+//g;

    return encode('UTF-8', $str, Encode::FB_CROAK);
}

sub json_request {
    my ($method, $path, $content) = @_;

    # TODO(nsenica): Implement proper throttling control.
    sleep(0.1);
    
    my $url = $json_baseurl . $path;

    print( STDERR "json_request(" . $method . ") url: " . $url . "\n" ) if( $opt->{debug} );

    my @params;
    push(@params, content_type => 'application/x-www-form-urlencoded; charset=UTF-8');
    push(@params, content => $content) if defined $content;
    my $response = $ua->$method($url, @params);
    if($response->is_success()) {
        return JSON->new->utf8(1)->decode( $response->decoded_content());
    }
    else {
        my $msg = $response->decoded_content();

        if($response->header('content-type') =~ m{text/html;charset=UTF-8}i) {
            my $error = decode_json($msg);

            $msg = "Server (ID=$error->{'serverID'} Time=$error->{'datetime'}) returned an error:\n"
                ."$error->{'message'} ($error->{'code'}/$error->{'response'})";
        }

        print( STDERR " Error on the remote EPG API call\n" )  if( !$opt->{quiet} );
        print( STDERR $msg . "\n" )  if( $opt->{debug} );

        return JSON->new->utf8(1)->decode('{"data": [] }');
    }
}

sub make_episode_num
{
    my ($programme) = @_;

    return unless $programme->{metas}{'season number'};

    my $output;

    my $season;
    my $episode;

    if ( $programme->{metas}{'season number'}{value} ) {
        $season = $programme->{metas}{'season number'}{value} - 1;
    }

    if ( $programme->{metas}{'episode num'}{value} ) {
        $episode = $programme->{metas}{'episode num'}{value} - 1;
    }

    $output = [ [ ($season // "") . "." . ($episode // "") . ".", 'xmltv_ns' ] ] if (defined $season || defined $episode);

    if ( defined $season && defined $episode ) {
        push @{ $output }, [ ($season+1) ." ". ($episode+1) , 'onscreen' ];
    }
    elsif ( defined $season ) {
        push @{ $output }, [ ($season+1) , 'onscreen' ];
    }
    elsif ( defined $episode ) {
        push @{ $output }, [ ($episode+1) , 'onscreen' ];
    }
    return $output;

}

sub make_dates
{
    my( $startTime, $endTime, $curDate ) = @_;

    my $dtstart = DateTime->from_epoch(epoch => $startTime);
    my $starts_today = 0;
    # does the programme start on the day we want listings for?
    if ($dtstart->day == $curDate->day) {
        $starts_today = 1;
    }

    my $dtend = DateTime->from_epoch(epoch =>$endTime);

    # dates look like GMT, we tried UTC but in summer time they fail
    return ($dtstart->strftime( '%Y%m%d%H%M%S +0000' ), $dtend->strftime( '%Y%m%d%H%M%S +0000' ), $starts_today);

}

sub make_channelid
{
    my( $id ) = @_;
    $id = lc( $id );      # turn into lowercase
    $id =~ s/\s+//g;      # remove whitespace
    $id =~ s/&//g;        # remove ampersand
    $id =~ s/!//g;        # remove !
    $id =~ s/\"//g;       # remove ""
    $id =~ s/\+/-plus/g;  # turn + into -plus
    $id = unidecode($id);
    $id .= '.tv.vodafone.pt'; # append domain part
    return( $id );
}

sub unquote {
    my ($str) = @_;
    $str =~ s/^"//;
    $str =~ s/"$//;
    return $str;
}

sub get_title {
    my ($programme) = @_;
    return [ [ sanitizeUTF8($programme->{name}), 'pt' ] ];
}

sub get_desc {
    my ($programme) = @_;
    return [ [ sanitizeUTF8($programme->{description}), 'pt' ] ] if ($programme->{description});
}

sub get_length {
    my ($programme) = @_;
    if ($programme->{metas}{'display duration'}{value}) {
        my $duration_str = $programme->{metas}{'display duration'}{value};
        my @duration_items = split(/[PTHMS]/, $duration_str);
        return $duration_items[2] * 3600 + $duration_items[3] * 60 + $duration_items[4] if scalar @duration_items;
    }
}

sub get_icon {
    my ($programme) = @_;
    if ($programme->{images}[0]{url} && $programme->{images}[0]{imageTypeName} eq "ca") {
        return [ { src => $programme->{images}[0]{url} . "/width/360/height/640/quality/95" } ];
    }
    if ($programme->{images}[0]{url} && $programme->{images}[0]{imageTypeName} eq "cc") {
        return [ { src => $programme->{images}[0]{url} . "/width/640/height/360/quality/95" } ];
    }
}

sub get_category {
    my ($programme) = @_;
    if ($programme->{tags}{genre}) {
        my @category = map { [ sanitizeUTF8($_->{value}), 'pt' ] } @{$programme->{tags}{genre}{objects}};
        return \@category;
    }
}

sub get_country {
    my ($programme) = @_;
    return [ [ sanitizeUTF8($programme->{tags}{'country of production'}{objects}[0]{value}), 'pt' ] ] if $programme->{tags}{'country of production'};
}

sub get_rating {
    my ($programme) = @_;
    if ($programme->{tags}{'parental Rating'}) {
        my $rating;
        if ($programme->{tags}{'parental Rating'}{objects}[0]{value} == 0) {
            $rating = [ [ "All Ages", 'Portuguese Movie Rating' ] ];
        } else {
            $rating = [ [ "M/" . $programme->{tags}{'parental Rating'}{objects}[0]{value}, 'Portuguese Movie Rating' ] ];
        }
        return $rating if $rating;
    }
}

sub get_images {
    my ($programme) = @_;
    my @images;
    for my $image (@{$programme->{images}}) {
        next if !$image->{url};

        my $type = "";
        my $orient = "";
        my $size = 3;
        my $system = "vodafone";
        my $width = 640;
        my $height = 360;

        if ($image->{imageTypeName} eq "cc") {
            $orient = "L";
            $type = "still";
        } elsif ($image->{imageTypeName} eq "ca") {
            $orient = "P";
            $type = "poster";
            $width = 360;
            $height = 640;
        } elsif ($image->{imageTypeName} eq "bg") {
            $orient = "L";
            $type = "backdrop";
        }

        push @images, [ $image->{url} . "/width/" . $width . "/height/" . $height . "/quality/95", { type => $type, size => $size, orient => $orient, system => $system } ];
    }
    return \@images if scalar @images;
}

sub get_date {
    my ($programme) = @_;
    return sanitizeUTF8($programme->{metas}{year}{value}) if $programme->{metas}{year}{value};
}

sub get_actors {
    my ($programme) = @_;
    if ($programme->{tags}{actors}) {
        my @actors = map { sanitizeUTF8($_->{value}) } @{$programme->{tags}{actors}{objects}};
        return \@actors;
    }
}

sub get_directors {
    my ($programme) = @_;
    if ($programme->{tags}{director}) {
        my @directors = map { sanitizeUTF8($_->{value}) } @{$programme->{tags}{director}{objects}};
        return \@directors;
    }
}