VDR Portal

Source code

#!/usr/bin/perl
use Socket;

$tvtime    = '/usr/bin/tvtime --slave';
$tvtimecmd = '/usr/bin/tvtime-command';
$mapfile   = '/etc/tvtime/map.txt';
$svdrpsend = '/usr/bin/svdrpsend.pl';

my %mapped;
my $timeout = 0;

open(IN, "<$mapfile") || die "cannot open mapfile: $mapfile";
while(<IN>)
{
  chomp;
  my @line = split( /\t/, $_ );
  $mapped{$line[0]} = $line[1];
}
close(IN);

$Dest = "127.0.0.1";
$Port = 2001;
$| = 1;

open(IN, "$tvtime|") || die "cannot open pipe";
MainLoop();

sub MainLoop ()
{
  print STDOUT "DEBUG Mainloop\n";

  do {
    OpenSocket();
    while(<IN>)
    {
      chomp;
      next if /^\0$/;
      if ( $mapped{$_} eq "" ) { $mapped{$_} = $_ }

      if ( $mapped{$_} =~ /TVTIME_/)
      {
        $cmd = $mapped{$_};
        $cmd =~ s/TVTIME_//;
        SendTvtime($cmd);
      }
      else
      {
        SendKey($mapped{$_});
      }
    }
  } while (TimeOut);
  Send("quit");
  close(SOCK)                                 || Error("close: $!");
  close(IN);

  print "DEBUG: tvtime exited.\n";
}

sub TimeOut
{
  print STDOUT "TIMEOUT $timeout\n";
  if ($timeout) {$timeout = 0; return 1;}
  return 0;
}

sub SendTvtime
{
system("$tvtimecmd KEY_EVENT $cmd")
}

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

sub SendKey
{
  my $cmd = shift || Error("no key to send");
  print SOCK "HITK $cmd\n";
  Receive();
}

sub OpenSocket
{
  $iaddr = inet_aton($Dest)                   || Error("no host: $Dest");
  $paddr = sockaddr_in($Port, $iaddr);
  $proto = getprotobyname('tcp');

  close(SOCK);
  socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || Error("socket: $!");
  connect(SOCK, $paddr)                       || Error("connect: $!");
  select(SOCK) || Error ;
  $| = 1;
  Receive();
}

sub Receive
{
  while (<SOCK>)
  {
    if ( $_ =~ /^221/)
    {
      print STDOUT "timeout detected\n";
      $timeout = 1;
      OpenSocket();
      return;
    }
    print STDOUT $_;
    last if substr($_, 3, 1) ne "-";
  }
}

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

Source code

#!/usr/bin/perl
use Socket;
use Time::HiRes qw(setitimer ITIMER_VIRTUAL);

$tvtime    = '/usr/bin/tvtime --slave';
$tvtimecmd = '/usr/bin/tvtime-command';
$mapfile   = '/etc/tvtime/map.txt';
$svdrpsend = '/usr/bin/svdrpsend.pl';
$timeout = 250;

my %mapped;

open(IN, "<$mapfile") || die "cannot open mapfile: $mapfile";
while(<IN>)
{
  chomp;
  my @line = split( /\t/, $_ );
  $mapped{$line[0]} = $line[1];
}
close(IN);

$Dest = "127.0.0.1";
$Port = 2001;
$| = 1;

open(IN, "$tvtime @ARGV |") || die "cannot open pipe";
OpenSocket();

# keep alive
$SIG{ALRM} = sub { SendVDR("HELP"); };
setitimer(ITIMER_PROF, $timeout, $timeout);

$tvtimealive = 1;
while($tvtimealive)
{
  chomp($key=<IN>);
  printf(STDOUT "Key $key %d\n", ord($key));
  next if $key =~ /^\0$/;

  if ( ord($key) == 0 )
  {
    $tvtimealive = 0;
    next;
  }

  if ( $mapped{$key} eq "" ) { $mapped{$key} = $key }
  if ( $mapped{$key} =~ /TVTIME_/)
  {
    $cmd = $mapped{$key};
    $cmd =~ s/TVTIME_//;
    SendTvtime("KEY_EVENT $cmd");
  }
  else
  {
    SendVDR("HITK $mapped{$key}");
  }
}

SendVDR("quit");
close(VDRSOCK) || Error("close: $!");
close(IN);

print STDOUT "DEBUG: tvtime exited.\n";
exit(0);

sub SendTvtime
{
  $cmd = shift || Error("no key to send");
  system("$tvtimecmd $cmd")
}

sub SendVDR
{
  my $cmd = shift || Error("no key to send");
  print VDRSOCK "$cmd\n";
  Receive();
}

sub OpenSocket
{
  $iaddr = inet_aton($Dest) || Error("no host: $Dest");
  $paddr = sockaddr_in($Port, $iaddr);
  $proto = getprotobyname('tcp');

  socket(VDRSOCK, PF_INET, SOCK_STREAM, $proto) || Error("socket: $!");
  connect(VDRSOCK, $paddr) || Error("connect: $!");
  select(VDRSOCK) || Error ;
  $| = 1;
  Receive();
}

sub Receive
{
  while (<VDRSOCK>)
  {
    if ( $_ =~ /^221.*timeout/)
    {
      print STDOUT "timeout detected\n";
      OpenSocket();
      return;
    }
    print STDOUT "$_";
    last if substr($_, 3, 1) ne "-";
  }
}

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