#!/usr/bin/perl
#
# cp-epg.pl
#
# Feeding epg data from DVB channels to corresponding channels.
#
# Stefan Nehlsen 2006
#
# This script is based on svdrsend.pl.
use Socket;
use Getopt::Std;
use Data::Dumper;

# adjust this hash
# "pvrinput destination channel" => "dvb-t source channel"
%mappings = (
	"k06 Das Erste" => "Das Erste",
	"k08 ZDF" => "ZDF",
	"k07 NDR" => "NDR FS SH",
	"SE4 RTL" => "RTL",
	"SE5 SAT1" => "SAT.1",
	"k12 RTL2" => "RTL2",
	"k11 Pro7" => "ProSieben",
	"S23 SRTL" => "Super RTL",
	"SE16 KIKA" => "Doku/KiKa",
	"SE10 VOX" => "VOX",
	"SE9 Kabel1" => "KABEL1",
	"SE17 BR" => "Bayerisches Fernsehen",
	"SE18 WDR" => "WDR Köln",
	"SE15 MDR" => "MDR FERNSEHEN",
	"SE14 N24" => "N24",
	"SE6 Arte" => "arte",
	"SE8 Phoenix" => "Phoenix",
	"SE11 3SAT" => "3sat",
	"SE20 9live" => "NEUN LIVE Television",
	"k23 Tele5" => "TELE 5"
);

$Usage = qq{
Usage: $0 options

Options: -d hostname        destination hostname (default: localhost)
         -p port            SVDRP port number (default: 2001)
         -q                 quiet
         -v n               verbose level
};

die $Usage if (!getopts("d:p:v:q"));

$Dest = $opt_d  || "localhost";
$Port = $opt_p  || 2001;
$debug = $opt_v || 0;
$silent = $opt_q;

# Copying epg-data takes some time, but shouldn't
# take longer than 2 minutes.
$Timeout = 120;

$SIG{ALRM} = sub { Error("timeout"); };
alarm($Timeout);

$iaddr = inet_aton($Dest)                   || Error("no host: $Dest");
$paddr = sockaddr_in($Port, $iaddr);

$proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || Error("socket: $!");
connect(SOCK, $paddr)                       || Error("connect: $!");
select(SOCK); $| = 1;

my @l = Receive(); # looking for initial greeting
Error("initial greeting failed") unless scalar @l == 1 and $l[0] =~ /^220[- ]/;

# reading channel list
my %channels = ();
foreach ( grep { s/^250[- ]// } Send("LSTC")) {
	my($id, @l) = split ":";
	$id =~ s/^(\d+) //; my %chan = ( kanal => $1 );
	$id =~ s/;(.*?)$//;  $chan{bouquet} = $1;
	push @{$chan{name}}, split ",", $id;
	my @keys = qw(freq param src srate vpid apid tpid ca sid nid tid rid);
	foreach(@l) {
		$chan{shift @keys} = $_;
	}
	warn "channel: $kanal existiert bereits!\n" if exists $channels{$kanal};
	warn "channel: $name existiert bereits!\n" if exists $channels{$name};
	foreach ( $chan{kanal}, @{$chan{name}} ) {
		$channels{$_} = \%chan;
	}
}

print STDOUT Dumper(\%channels) if $debug > 1;

# reading epg from source channels
my %epg;
foreach my $channel (values %mappings) {
	next if exists $epg{$channel};
	my @entry = ();
	foreach ( grep { s/^215[- ]// } Send("LSTE " . $channels{$channel}{'kanal'})) {
		if(/^E /) {
			@entry = ( $_ );
		}elsif(/^e/){
			push @{$epg{$channel}}, [ @entry, $_ ];
		} else {
			push @entry, $_ if @entry;
		}
	}
}
print STDOUT Dumper(\%epg) if $debug > 1;

# storing epg data
while( my($dest, $src) = each %mappings) {
	if(! @{$epg{$src}}) {
		printf STDOUT "No EPG found for %s (%s).\n",
			$channels{$src}{'name'}[0], $channels{$src}{'kanal'}
			unless $silent;
		next;
	}

	printf STDOUT "Copying EPG (%d) from \"%s\"(%d) to \"%s\"(%d)\n",
		scalar @{$epg{$src}},
		$channels{$src}{'name'}[0], $channels{$src}{'kanal'},
		$channels{$dest}{'name'}[0], $channels{$dest}{'kanal'}
		unless $silent;

	print STDOUT "PUTE\n" if $debug;
	my @warning = Send("PUTE");
	@warning = () if $warning[0] =~ /^354[- ]/;
	warn join("\n", "PUTE start:", @warning)."\n" if @warning;
	# creating channel id
	my $s = "C " . $channels{$dest}{'src'} . "-" . 
		$channels{$dest}{'nid'} . "-" .
		($channels{$dest}{'nid'} > 0 ? $channels{$dest}{'tid'} : int($channels{$dest}{'freq'} / 1000)) . "-" .
		$channels{$dest}{'sid'} . " " . $channels{$dest}{'name'}[0];

	print STDOUT $s, "\n" if $debug;
	SendOnly($s);
	foreach (@{$epg{$src}}) {
		foreach (@{$_}) {
			# making the event id unique
			s/^E (\d+) /sprintf("E %d ", $1 + 65536)/e;
			next unless /^[ETSDXVe]/;
			print STDOUT $_, "\n" if $debug;
			SendOnly($_);
		}
	}
	print STDOUT "c\n" if $debug;
	SendOnly("c");
	print STDOUT ".\n" if $debug;

	@warning = Send(".");
	@warning = () if $warning[0] =~ /^250[- ]/;
	warn join("\n", "PUTE end:", @warning)."\n" if @warning;
}


Send("quit");
close(SOCK)                                 || Error("close: $!");

sub SendOnly {
	my $cmd = shift || Error("no command to send");
	print SOCK "$cmd\r\n";
}

sub Send {
	my $cmd = shift || Error("no command to send");
	print SOCK "$cmd\r\n";
	return Receive();
}

sub Receive {
	my @l;
	while (<SOCK>) {
		chop; s/\r$//g;
		push @l, $_;
        	return @l if substr($_, 3, 1) ne "-";
	}
}

sub Error {
	print STDERR "@_\n";
	close(SOCK);
	exit 0;
}

# eof