#!/usr/bin/perl
# Copyright © 2011 Petr Písař
# This is free software.  You may redistribute copies of it under the terms of
# the GNU General Public License <http://www.gnu.org/licenses/gpl.html>.
# There is NO WARRANTY, to the extent permitted by law.

use strict;
use warnings;
our $VERSION = 1;

use LWP::UserAgent;
use HTTP::Request::Common;
use HTTP::Response;
use XML::XPath;
use URI;
use JSON 2.0;

my $SMIL_GENERATOR = '/ajax/playlistURL.php';
my $ENTRY = 'http://www.ct24.cz/vysilani/';

sub usage {
    print<<EOM;
Usage: ctstream ENTRY_PAGE [STREAM_BITRATE]

Get URLs of Czech Television video streams for specific ENTRY_PAGE (e.g.
$ENTRY). If this is the only argument, output list of
all available streams in format `STREAM_BITRATE: URL' separated by new line.
If STREAM_BITRATE is given, output URL of the stream with given rate only.

Version: $VERSION.
Copyright © 2011 Petr Písař
This is free software.  You may redistribute copies of it under the terms of
the GNU General Public License <http://www.gnu.org/licenses/gpl.html>.
There is NO WARRANTY, to the extent permitted by law.
EOM
}

if ($#ARGV < 0 || $#ARGV > 1) {
    usage;
    die "Bad invocation\n";
}
$ENTRY = $ARGV[0];
my $BITRATE = $ARGV[1];

# Convert nested JSON structure expressed as native hash reference into flat
# array of key and value pairs.
# E.g. { "x" => [ "y" => "1", "z" => undef ] }
# becomes ( "x[0][y]", "1", "x[1][z] => null ).
# This is handy when sending nested JSON structure as
# application/x-www-form-urlencoded by HTTP::Request::Common.
sub flatten {
    my ($ref, $prefix) = @_;
    my @output = ();
    while (my ($key, $val) = (ref $ref eq 'HASH') ? each %$ref : each @$ref) {
        # TODO: Escape /[[]=]/
        my $id = (defined $prefix) ? $prefix . '[' . $key . ']' : $key;
        if (ref $val eq 'HASH' || ref $val eq 'ARRAY') {
            push @output, flatten($val, $id);
        } else {
            push @output, ($id, $val // 'null');
        }
    }
    return @output;
}


# Find first pattern match in HTML page, HTML-unescape it and return it.
# Otherwise return undef.
sub htmlgrep {
    my ($html_page, $pattern) = @_;
    my ($text) = ($html_page =~ $pattern);
    if (! defined $text) { return undef; }
    $text =~ s/&amp;/&/g;
    $text =~ s/&gt;/>/g;
    $text =~ s/&lt;/</g;
    return $text;
}



# Get entry HTML page
my $ua = LWP::UserAgent->new;
my $response = $ua->request(GET $ENTRY);
$response->is_success or
    die "Could not get entry page: $ENTRY: " . $response->status_line . "\n";
my $page = $response->decoded_content;

# Get iframe player URL
# The web page is not well-formed XML, we cannot use XPath 
# '//html:div[@id="iFramePositionContainer"]/html:iframe/@src';
# This is sometimes relative, sometimes absolute path
my $iframe_url = htmlgrep($page,
    qr{src="([^"]*/embed/iFramePlayer\.php[^"]*)"});
defined $iframe_url && $iframe_url or
    die "Could not find iframe address in $ENTRY\n";
$iframe_url = URI->new_abs($iframe_url, $ENTRY);


# Get iframe player page
$response = $ua->request(GET $iframe_url);
$response->is_success or
    die "Could not get iframe player: $iframe_url: " .
        $response->status_line . "\n";
$page = $response->decoded_content;

# Get JSON request data
my $json_data = htmlgrep($page, qr{callSOAP\(([^)]*)\);});
defined $json_data && $json_data or
    die "Could not find JSON data structure in player iframe $iframe_url\n";

# Decode JSON request data
my $data;
eval { $data = decode_json($json_data) } or 
    die "Could not decode JSON string: $json_data: $@\n";
my @data = flatten($data);


# Get SMIL playlist URL
my $smil_generator_url = URI->new_abs($SMIL_GENERATOR, $ENTRY);
$response = $ua->request(POST $smil_generator_url, \@data);
$response->is_success or
    die "Could not get SMIL playlist URL: " . $response->status_line . "\n";
my $smil_url = $response->decoded_content;


# Get SMIL playlist
$ua->agent('NSPlayer/0 (Fuck libwwperl discimination)');
$response = $ua->request(GET $smil_url);
$response->is_success or
    die "Could not get SMIL playlist: " . $response->status_line . "\n";
my $smil = $response->decoded_content;


# Get stream URLs
my $parser = XML::XPath->new('xml' => $smil) or
    die "Could not parse SMIL playlist: " . $smil . "\n";
my $videos =
    $parser->find('/data/smilRoot/body/switchItem/video[@enabled=true()]');
if ($videos->size <= 0) {
    die "No videos found in SMIL playlist: $smil\n";
}
my $video_counter = 0;
foreach my $video ($videos->get_nodelist) {
    my $suffix = $video->getAttribute('src');
    if (! defined $suffix) {
        print STDERR q{Missing `video/@src' attribute} . "\n";
        next;
    }
    my $prefix = $video->getParentNode->getAttribute('base');
    if (! defined $suffix) {
        print STDERR
            q{Missing `video/../@base' attribute for video } . "`$suffix'\n";
        next;
    }
    my $bitrate = $video->getAttribute('system-bitrate');
    if (! defined $suffix) {
        print STDERR
            q{Missing `video/@system-bitrate' attribute for video } .
            "`$suffix'\n";
        next;
    }

    # Output URL
    my $stream_url = URI->new($prefix . '/' . $suffix);
    if (defined $BITRATE) {
        if ($bitrate == $BITRATE) {
            print "$stream_url\n";
            $video_counter++;
        }
    } else {
        print "$bitrate: $stream_url\n";
        $video_counter++;
    }
}
if ($video_counter <= 0) {
    die "No usable video streams found in SMIL playlist: $smil\n";
}