Tvheadend

#!/usr/bin/perl

# Perl version of AutoBouquets E2 28.2E by LraiZer for www.ukcvs.org

# modified to integrate with TVHeadend

# by Jonathan Kempson - [email protected]

use 5.010;

use strict;

use warnings;

use Data::Dumper;

use LWP::Simple qw(get);

use JSON;

use URI::Escape;

use List::Util qw(first);

use LWP::Simple qw($ua head);

# Required regional data/region here (use SD version if HD channel verification required)

my $data_sd   = "4097";

my $region_sd = "07";

# HD data/region here to be verified. Set to "" to skip HD channel verification

my $data_hd   = "";

my $region_hd = "";

# TVH configuration

my $tag_channels  = 1;

my $tvh_user      = "someuser";

my $tvh_pass      = "somepassword";

my $tvh_ip        = "someip";

my $tvh_proto     = "http";

my $tvh_port      = "9981";

my $tvh_tag       = "TV channels";

my $icons_enabled = 1;

# Change 'on' => 1 to 'on' => 0 if you don't want that channel group

my %chan_tags = (

    'Entertainment'         => { 'num' => 101,  'on' => 1 },

    'Lifestyle and Culture' => { 'num' => 240,  'on' => 1 },

    'Movies'                => { 'num' => 301,  'on' => 1 },

    'Music'                 => { 'num' => 350,  'on' => 1 },

    'Sports'                => { 'num' => 401,  'on' => 1 },

    'News'                  => { 'num' => 501,  'on' => 1 },

    'Documentaries'         => { 'num' => 520,  'on' => 1 },

    'Religious'             => { 'num' => 580,  'on' => 1 },

    'Kids'                  => { 'num' => 601,  'on' => 1 },

    'Shopping'              => { 'num' => 640,  'on' => 1 },

    'Sky Box Office'        => { 'num' => 700,  'on' => 1 },

    'International'         => { 'num' => 780,  'on' => 1 },

    'Gaming and Dating'     => { 'num' => 861,  'on' => 1 },

    'Specialist'            => { 'num' => 881,  'on' => 1 },

    'Adult'                 => { 'num' => 900,  'on' => 1 },

    'Other'                 => { 'num' => 950,  'on' => 1 },

    'Radio'                 => { 'num' => 3101, 'on' => 0 },

);

# Manual add channel, number:SID, for channels that may not be in your bouquet		

my @sid_adds  = ("131:10155");

say "Started";

my $tvh_url = $tvh_proto . "\:\/\/" . $tvh_user . "\:" . $tvh_pass . "\@" . $tvh_ip . "\:" . $tvh_port;

say "Get Channel Tags...";

my %chan_ids = tvhTagHash( $tvh_tag, \%chan_tags );

say "Done";

#my $f_dvb = "/tmp/abm_dvb.txt";

#my @dvb   = readFile($f_dvb);

# Run dvbsnoop

my @dvb = `dvbsnoop -nph -n 500 0x11`;

if ( scalar(@dvb) <= 1 ) { die "No data received. You must have root access?"; }

# Get SDT

say "Get SDT...";

my @sdt = serviceDescriptionTable( \@dvb );

say "Done";

# Get service lists

say "Get services";

my @services_sd    = populateServices($data_sd, $region_sd, @dvb, @sdt);

@services_sd = sort( uniqArray(@services_sd) );

say "Done";

my @merged_services;

if (($data_hd ne "") && ($region_hd ne "")) {

	my @services_hd    = populateServices($data_hd, $region_hd, @dvb, @sdt);

	@services_hd = sort( uniqArray(@services_hd) );

	my @services_hd_checked;

	$ua->timeout(10);

	my @tvh_services = tvhQuery("mpegts/service/grid?dir=ASC&limit=100000&sort=sid&start=0");

	foreach my $s_hd (@services_hd) {

		my $dupe = 0;

		foreach my $s_sd (@services_sd) {

			if ($s_hd eq $s_sd) { $dupe = 1; }

		}

		if ($dupe == 0) { 

			my @conv = split( " ", $s_hd );

			my $serv_type = tvhServiceType( hex( $conv[2] ), \@tvh_services );

			# dvb_servicetype seems to be HD channels? Use to ignore SD channels returned in HD bouquet.

			if ($serv_type == 25) {	    

				my $chan_num  = hex( $conv[0] );

				my $chan_uuid = tvhServiceID( hex( $conv[2] ), \@tvh_services );

				my $chan_name = lookupService( "$conv[2]", \@sdt );

				my $url = "$tvh_url/stream/service/$chan_uuid";

				print "Testing channel $chan_num $chan_name...";

				if (head($url)) { 

					push (@services_hd_checked, $s_hd);

					print "ok\n"; 

				} else { 

					print "fail\n";

				}

			}

		}

	}

	foreach my $s_sd (@services_sd) {

		my @conv = split( " ", $s_sd );

		my $chan_num  = hex( $conv[0] );

		my $replace = $s_sd;

		foreach my $s_hd (@services_hd_checked) {

				my @conv_hd = split( " ", $s_hd );

				my $chan_num_hd  = hex( $conv_hd[0] );

				if ($chan_num eq $chan_num_hd) { $replace = $s_hd; }

		}

		push (@merged_services, $replace);

	}

} else {

	@merged_services = @services_sd;

}

foreach my $add (@sid_adds) {

	my @arr = split(":",$add);

	$arr[0] = sprintf( "%04x", $arr[0] );

	$arr[1] = sprintf( "%04x", $arr[1] );

	push @merged_services, "$arr[0] 0000 $arr[1] 0000";

}

@merged_services = sort( uniqArray(@merged_services) );

# Populate channels in TVH

say "Populate channels in TVH...";

updateTVH( \@merged_services, $tvh_tag, $tag_channels );

say "Done";

exit;

################################################################################

sub populateServices {

    my ( $data, $region, $dvb, $sdt ) = @_;

	my (@svcs, @sections);

	$region    = sprintf( "%02x", $region );

	say "Process regional services first...";

	processServices( $data, $region, \@dvb, \@svcs, \@sdt );

	say "Done";

	say "Everything else...";

	if ( ( $region ne "33" ) && ( $region ne "32" ) ) {

		# Use different base services if region is Irish

		processServices( "4104", "21", \@dvb, \@svcs, \@sdt );

	}

	else {

		processServices( "4101", "01", \@dvb, \@svcs, \@sdt );

	}

	say "Done";

	return @svcs;

}

sub updateTVH {

    my ( $services, $tvh_tag, $tag_channels ) = @_;

    my @tvh_tags = tvhQuery("channeltag/list?enum=true");

    my $tag_id = tvhTagID($tvh_tag);

    # Get all services from tvh

    my @tvh_services = tvhQuery("mpegts/service/grid?dir=ASC&limit=100000&sort=sid&start=0");

    my @tvh_channels = tvhQuery("channel/grid?dir=ASC&limit=100000&sort=number&start=0");

    my @chan_list;

    my @sid_dupes;

    foreach my $line (@$services) {

		my @conv = split( " ", $line );

        my $chan_num  = hex( $conv[0] );

        my $chan_name = lookupService( "$conv[2]", \@sdt );

        my $chan_epg  = hex( $conv[1] );

        my $chan_logo = "http://tv.sky.com/logo/0/0/skychb" . $chan_epg . ".png";

        my ( @j_sid, @j_tag );

        my $chan_uuid = tvhServiceID( hex( $conv[2] ), \@tvh_services );

        push @j_sid, $chan_uuid;

        # Duplicate channels with different channel numbers seem to cause problems with EPG in XBMC (perhaps others)?

        # EPG sometimes isn't imported for channels which are assigned multiple channel numbers.

        # Skip channel if it has been seen earlier.

        my $skip = 0;

        if ( first { $_ eq $chan_uuid } @sid_dupes ) {

            $skip = 1;

        }

        push @sid_dupes, $chan_uuid;

        # Ignore useless channels 65535

        if ( $chan_num == 65535 ) { $skip = 1; }

        push @j_tag, $tag_id;

        # Add tag info if enabled

        if ( $tag_channels == 1 ) {

            if ( $chan_tags{ chanToTag($chan_num) }->{on} == 1 ) {

                push @j_tag, $chan_ids{ chanToTag($chan_num) };

            }

            else {

                $skip = 1;

            }

        }

        # Create hash of channel data to be added

        if ( $skip == 0 ) {

            my %chan_hash = (

                'name'         => $chan_name,

                'number'       => $chan_num,

                'services'     => \@j_sid,

                'tags'         => \@j_tag,

                'dvr_pre_time' => '0',

                'dvr_pst_time' => '0'

            );

            if ($icons_enabled !=0) {

            	$chan_hash{'icon'} = $chan_logo;

            }

            push @chan_list, $chan_num;

            tvhUpdateChannel( \@tvh_channels, $tag_id, \%chan_hash );

        }

    }

    # Remove orphan channels

    foreach my $chan (@tvh_channels) {

        my $tag_check = 0;

        foreach my $tag ( @{ $chan->{tags} } ) {

            if ( $tag eq $tag_id ) { $tag_check = 1; }

        }

        my $found = 0;

        for my $line (@chan_list) {

            if ( $chan->{number} eq $line ) { $found = 1; }

        }

        if ( ( $found == 0 ) && ( $tag_check == 1 ) ) {

            say "Removing orphaned channel $chan->{number} $chan->{name}";

            get( $tvh_url . "/api/idnode/delete?uuid=" . uri_escape( $chan->{uuid} ) );

        }

    }

}

sub tvhTagHash {

    my ( $tvh_tag, $chan_tags ) = @_;

    my @tvh_tags;

    push @tvh_tags, $tvh_tag;

    foreach my $ch ( sort keys %chan_tags ) {

        push @tvh_tags, $ch;

    }

    my %chan_ids;

    foreach my $ch (@tvh_tags) {

        my $tag_id = tvhTagID($ch);

        if ( !$tag_id ) {

            $tag_id = tvhCreateTag($ch);

        }

        $chan_ids{$ch} = $tag_id;

    }

    return %chan_ids;

}

sub chanToTag {

    my ( $chan, $chan_tags ) = @_;

    my $tag = "";

    foreach my $n ( sort { $chan_tags{$b}->{num} <=> $chan_tags{$a}->{num} } keys %chan_tags ) {

        if ( $chan >= $chan_tags{$n}->{num} ) {

            $tag = $n;

            last;

        }

    }

    return $tag;

}

sub tvhTagID {

    my ($tvh_tag) = @_;

    my @tvh_tags = tvhQuery("channeltag/list?enum=true");

    my $tag_id;

    foreach my $tag (@tvh_tags) {

        if ( $tag->{val} eq $tvh_tag ) { $tag_id = $tag->{key}; }

    }

    return $tag_id;

}

sub tvhCreateTag {

    my ($tag_name) = @_;

    my $post       = "{\"enabled\":true,\"name\":\"" . $tag_name . "\",\"internal\":false,\"icon\":\"\",\"titled_icon\":false,\"comment\":\"\"}";

	say "Adding channel tag $tag_name";

    get( $tvh_url."/api/channeltag/create?conf=".uri_escape($post)); 

    return tvhTagID($tag_name);

}

sub tvhUpdateChannel {

    my ( $tvh_channels, $tag_id, $post_json ) = @_;

    my $matches    = 0;

    my $chan_exist = "";

    for my $line (@$tvh_channels) {

        my $tag_check = 0;

        foreach my $tag ( @{ $line->{tags} } ) {

            if ( $tag eq $tag_id ) { $tag_check = 1; }

        }

        if ( $tag_check == 1 ) {

            if ( $line->{number} eq $post_json->{number} ) {

                $matches    = 1;

                $chan_exist = $line->{uuid};

                my $servs      = join( "", sort( @{ $line->{services} } ) );

                my $post_servs = join( "", sort( @{ $post_json->{services} } ) );

                my $tags      = join( "", sort( @{ $line->{tags} } ) );

                my $post_tags = join( "", sort( @{ $post_json->{tags} } ) );

                if ( $line->{name} ne $post_json->{name} ) { $matches = 0 }

                if ($icons_enabled == 1) {

                	if ( $line->{icon} ne $post_json->{icon} ) { $matches = 0 }

                }

                if ( $servs        ne $post_servs )        { $matches = 0 }

                if ( $tags         ne $post_tags )         { $matches = 0 }

                last;

            }

        }

    }

    if ( $matches == 0 ) {

        if ( $chan_exist ne "" ) {

            say "Deleting old channel $post_json->{number}";

            get( $tvh_url . "/api/idnode/delete?uuid=" . uri_escape($chan_exist) );

        }

        say "Adding channel $post_json->{number} $post_json->{name}";

        get( $tvh_url . "/api/channel/create?conf=" . uri_escape( encode_json($post_json) ) );

    }

}

sub tvhQuery {

    my ($query) = @_;

    my $url    = $tvh_url . '/api/' . $query;

    my $return = from_json( get($url) );

    return @{ $return->{entries} };

}

sub tvhServiceID {

    my ( $search, $decoded ) = @_;

    my $uuid = "";

    foreach my $line (@$decoded) {

        if ( $line->{sid} eq $search ) { $uuid = $line->{uuid}; last; }

    }

    return $uuid;

}

sub tvhServiceType {

    my ( $search, $decoded ) = @_;

    my $uuid = "";

    foreach my $line (@$decoded) {

        if ( $line->{sid} eq $search ) { $uuid = $line->{dvb_servicetype}; last; }

    }

    return $uuid;

}

sub uniqArray {

    return keys %{ { map { $_ => 1 } @_ } };

}

sub processServices {

    my ( $data, $region, $dvb, $svcs, $sdt ) = @_;

    my @sections = findSections( $data, \@dvb );

    return streamData( $region, \@sections, $svcs, \@sdt );

}

sub streamData {

    my ( $region, $sections, $conv_data, $sdt ) = @_;

    my ( @data, $hex, $ts, $code, $pcode );

    # If there is already data in services array then turn on duplicate checking

    my $check_dupes;

    if ( scalar(@$conv_data) > 0 ) {

        $check_dupes = 1;

    }

    else {

        $check_dupes = 0;

    }

    foreach my $line (@$sections) {

        if ( $line =~ /^    Transport_stream_ID/ ) {

            ($ts) = $line =~ /\(.*x([^\)]+)/;

            $ts    = trim($ts);

            $pcode = -1;

            push( @data, $hex );

            $hex = $ts;

        }

        if ( $line =~ /^                 00/ ) {

            $line =~ s /(.{74}).*/${1}/s;

            $line =~ s/\h+/ /g;

            $line = trim($line);

            $code = hex( substr( $line, 0, 4 ) );

            $line = substr( $line, 5 );

            if ( $code <= $pcode ) {

                push( @data, $hex );

                $hex = $ts;

            }

            $pcode = $code;

            $hex = $hex . $line;

        }

    }

    push( @data, $hex );

    shift @data;

    filterServices( \@data, $region );

    for my $line (@data) {

        my $count      = 1;

        my $number     = 7;

        my $serv_count = length($line) / 27;

        my $code       = substr( $line, 0, 4 );

        while ( $count < $serv_count ) {

            my @s = split( " ", substr( $line, $number, 27 ) );

            my $out = $s[6] . $s[7] . " " . $s[4] . $s[5] . " " . $s[1] . $s[2] . " " . $code;

            my $found = 0;

            if ( $check_dupes eq 1 ) {

                my $d = substr( $out, 0, 4 );

                if ( grep( /^$d/i, @$conv_data ) ) { $found = 1; }

            }

            if ( $found == 0 ) {

                push( @$conv_data, $out );

            }

            $number = $number + 27;

            $count++;

        }

    }

    return @$conv_data;

}

sub filterServices {

    my ( $data, $region ) = @_;

    my $i = 0;

    do {

        if ( ( substr( @$data[$i], 8, 2 ) ne $region ) && ( substr( @$data[$i], 5, 2 ) ne "ff" ) ) {

            splice @$data, $i, 1;

        }

        else {

            $i++;

        }

    } until ( $i == scalar(@$data) );

    return @$data;

}

sub lookupService {

    my $search = shift;

    my $sdt    = shift;

    foreach my $line (@$sdt) {

        if ( $line =~ /^$search/ ) {

            $search = substr( $line, 10 );

            last;

        }

    }

    return $search;

}

sub findSections {

    # Extract relevant sections from dvbsnoop array based on $data bouquet info

    my ( $data, $dvb ) = @_;

    my @sections_ref = sectionsRef( $data, \@dvb );

    my @sections;

    my $sec_first = ( @$dvb[ $sections_ref[0] + 18 ] =~ /Section_number: (.*) \(/ )[0];

    my $sec_last  = ( @$dvb[ $sections_ref[0] + 19 ] =~ /Section_number: (.*) \(/ )[0];

    my $sec_cycle;

    # Set loop stop point to prevent repeat data

    if ( $sec_first == 0 ) {

        $sec_cycle = $sec_last;

    }

    else {

        $sec_cycle = $sec_first - 1;

    }

    foreach my $line (@sections_ref) {

        my $strt = $line;

        do {

            $strt++;

            push( @sections, @$dvb[$strt] );

        } while !( @$dvb[$strt] =~ /CRC/ );

        # sec_num = current sequence position

        my $sec_num = ( @$dvb[ $line + 18 ] =~ /Section_number: (.*) \(/ )[0];

        # If position in sequence matches stop point then exit

        if ( $sec_num == $sec_cycle ) { last; }

    }

    return @sections;

}

sub sectionsRef {

    # Extract positions of Bouquet_ID for $data in dvbsnoop array

    my ( $data, $dvb ) = @_;

    my $cnt = 0;

    my @sections;

    foreach my $line (@$dvb) {

        if ( $line =~ /Bouquet_ID: $data/ ) {

            push( @sections, ( $cnt - 14 ) . "\n" );

        }

        $cnt++;

    }

    return @sections;

}

sub serviceDescriptionTable {

    # Finds all service data from the dvbsnoop array

    my $dvb = shift;

    # Match any line in this array

    my $match = join( "|",

        qr/^Transport_Stream_ID:/,

        qr/^    Service_id:/,

        qr/^    Free_CA_mode:/,

        qr/^            service_provider_name:/,

        qr/^            Service_name:/,

        qr/^                 0000:  /,

    );

    # Do not include matching line if a second check matches any values here (not sure why?)

    my $no_match = join( "|", qr/^                 0000:  00/, qr/^                 0000:  ff/, qr/^                 0000:  1d/, );

    my @services;

    foreach my $line (@$dvb) {

        if ( ( $line =~ $match ) && !( $line =~ $no_match ) ) {

            push( @services, $line );

        }

    }

    return processSDT( \@services );

}

sub processSDT {

    my $services = shift;

    my @return;

    my ( $tsid, $sid, $sn, $ca, $spn );

    foreach my $line (@$services) {

        if ( $line =~ /Transport_Stream_ID/ ) {

            $tsid = get_hex($line);

        }

        if ( $line =~ /Service_id:/ ) {

            $sid = get_hex($line);

            $sn  = "";

        }

        if ( $line =~ /Free_CA_mode:/ ) {

            $ca = get_hex($line);

            if   ( $ca == 0 ) { $ca = "FTA"; }

            else              { $ca = "NDS"; }

        }

        if ( $line =~ /service_provider_name:/ ) {

            $spn = get_txt($line);

        }

        if ( $line =~ /Service_name:/ ) {

            $sn = get_txt($line);

            #push @return, "$sid:$tsid#$ca:$spn:$sn";

            push @return, "$sid:$tsid:$sn";

        }

        if ( $line =~ /0000:/ ) {

            if ( length($sn) == 0 ) {

                # Need a regexp here, this isn't nice :S

                $sn = trim( substr( $line, 70 ) );

                # push @return, "$sid:$tsid#$ca:BSkyB:$sn";

                push @return, "$sid:$tsid:$sn";

            }

        }

    }

    @return = sort( uniqArray(@return) );

    return @return;

}

sub get_txt {

    if ( $_[0] =~ /"(.+?)"/ ) { return $1; }

}

sub get_hex {

    my $return;

    ($return) = $_[0] =~ /\(.*x([^\)]+)/;

    $return = trim($return);

    return $return;

}

sub trim {

    ( my $s = $_[0] ) =~ s/^\s+|\s+$//g;

    return $s;

}

sub readFile {

    open( FH, $_[0] );

    my @buf = <FH>;

    close(FH);

    return @buf;

}