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

my $Dest = "localhost";
my $Port = 2001;

my $Timeout = 30; # max. seconds to wait for response

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

sub SplitLine($) {
    my ($line)=@_;
    if ($line =~ /^([0-9]{3})([- ])(.*)$/) {
        return ($1,$2,$3);
    }
    Error("Unidentified Line: $line");
}

sub CopyEPG($$) {
    my ($src,$dst)=@_;
    my @epg;

    print SOCK "LSTE $src\r\n";
    while (<SOCK>) {
        chomp;
        my ($code,$sep,$data)=SplitLine($_);
        if ($code==215 && $sep eq '-') {
            push @epg,$data;
        } else {
            print STDOUT "(2):$_\n";
        }
        last if ($code==215 && $sep eq ' ');
    }

    print SOCK "PUTE\r\n";
    foreach my $line (@epg) {
        $line =~ s/^C [^ ]* (.*)$/C $dst $1/;
        print SOCK "$line\r\n";
    }
    print SOCK ".\r\n";

    while (<SOCK>) {
        chomp;
        print STDOUT "(3):$_\n";
        my ($code,$sep,$data)=SplitLine($_);
        last if ($code==250 && $sep eq ' ');
    }
}

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

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

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

while (<SOCK>) {
    chomp;
    print STDOUT "(1):$_\n";
    my ($code,$sep,$data)=SplitLine($_);
    last if ($code=220 && $sep eq ' ');
}


CopyEPG("S19.2E-133-33-46","S19.2E-1-1082-20005"); # Sat.1  DE->AU
CopyEPG("S19.2E-133-33-899","S19.2E-1-1082-20004"); # Kabel 1  DE->AU
CopyEPG("S19.2E-133-33-898","S19.2E-1-1082-20002"); # ProSieben  DE->AU

print SOCK "quit\r\n";
while (<SOCK>) {
    chomp;
    print STDOUT "(4):$_\n";
    my ($code,$sep,$data)=SplitLine($_);
    last if ($code==221 && $sep eq ' ');
}
close(SOCK)                                 || Error("close: $!");