#!/usr/bin/perl
use strict;
use warnings;
use Socket;

#channel-id = source-nid-tid-sid-rid
#esempio:
#Rai 4;RAI:514000:B8M998Y0:T:27500:433=2:443=ita:451:0:8583:318:4:0
#T-318-4-8583
#Rai 4;RAI:10992:vC23M2O0S0:S13.0E:27500:523=2:604:0:100,183D:8514:318:12400:0
#S13.0E-318-12400-8514


my $Usage = qq{
Usage: $0 <channel-id-source> <channel-id-dest>
};

die $Usage if (!$ARGV[1]);

my $id_source = $ARGV[0];
my $id_dest = $ARGV[1];
my $Timeout = 300;
my $Dest = 'localhost';
my $Port = 6419;# 2001; #6419

# Connect to SVDRP socket (thanks to Sky plugin coders)
$SIG{ALRM} = sub { die("timeout"); };
alarm($Timeout);

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

my $proto = getprotobyname('tcp');
socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die("socket: $!");
connect(SOCK, $paddr)                       || die("connect: $!");
select((select(SOCK), $| = 1)[0]);

# Look for initial banner
SVDRPreceive(220);

SVDRPsend("LSTE $id_source");
my @a=SVDRPreceive(215);
my $epg; foreach (@a){
 if (/^215-C (.*?) /){$epg.="C $id_dest\r\n"; next;}
 #if (/^215-C (.*?)/){print $epg; exit;};
 $epg.=$1."\r\n" if(/^215-(.*$)/);
}
$epg.=".";
#print $epg;

SVDRPsend("PUTE");
SVDRPreceive(354);

SVDRPsend($epg);
SVDRPreceive(250);

SVDRPsend("QUIT");
SVDRPreceive(221);

close(SOCK);


#----------------------------------------------------------------------------------
# Send info over SVDRP (thanks to Sky plugin)
sub SVDRPsend {
    my $s = shift;
    print SOCK "$s\r\n";
}

# Recv info over SVDRP (thanks to Sky plugin)
sub SVDRPreceive {
    my $expect = shift | 0;

    my @a = ();
    while (<SOCK>) {
        s/\s*$//; # 'chomp' wouldn't work with "\r\n"
        push(@a, $_);
        if (substr($_, 3, 1) ne "-") {
            my $code = substr($_, 0, 3);
            warn("expected SVDRP code $expect, but received $code") if ($code != $expect);
            last;
        }
    }
    return @a;
}

