[vdr] Talking SVDRP over the net

[Juergen Schmidt <ju@ct.heise.de>]

Hello,

I just set up a video server in our basement. To control it via IR remote,
I wrote a small perl script, that reads from the LIRC device and talks via
TCP/SVDRP to the server.

The video signal is fed into a defunct VCR to
modulate it on a transport frequency and from there fed into the satelite
receiver. Now we can watch the videos on any TV in the house. (the only
shotcoming is, that there needs to be a computer as LIRC receiver nearby
to read the IR signals from the remote).

Feel free to use it for your purposes...

Klaus: if you want too, add it to your contrib section...

bye, ju

---- lirc2vdr -------
#!/usr/bin/perl

# Small script to read keys from /dev/lircd and transfer
# them via TCP to vdr listening on port 2001 - maybe on
# another machine

# Author: Juergen Schmidt (ju@ct.heise.de)
# Licence: GPL
# Version: 0.10

use Socket;
use strict;
use Getopt::Std;

use vars qw($opt_h $opt_p $opt_l $opt_d $opt_t);

# defaults
my $debug=0;                    # set with -d
my $lircd = "/dev/lircd";       # set with -l
my $vdr_host = "localhost";     # set with -h
my $vdr_port = 2001;            # set with -p
my $timeout = 0;                # set with -t, 0 disables

# some variables
my $line;
my $retstr;
my $key="";
my $num="";
my ($lastkey, $lastnum);

# command line arguments
parse_args();

# connect to lircd via Unix domain socket
socket(LSOCK, PF_UNIX, SOCK_STREAM, 0)      || die "socket: $!";
connect(LSOCK, sockaddr_un($lircd))         || die "connect $lircd: $!";

# connect to TCP port of vdr
if (open_vdr()!=1) {
    die "Couldn't TCP open connection";
}

# lircd event loop
while ( 1 ) {
    # Set timeout for lirc input
    eval {
	local $SIG{ALRM} = sub { die "LIRC Timeout" };
	alarm $timeout;
	$line = <LSOCK>;
	alarm 0;
    };
    # close connection to vdr after timeout
    # and continue reading
    if ($@ and $@ =~ /LIRC Timeout/) {
	if ($debug) { print "Timeout after $timeout s\n"; }
	close_vdr();
	$line = <LSOCK>;
    }

    if ($debug) { print $line; }

    # lircd reports pressed keys multiple times
    # so we have to check for this
    $lastkey=$key;
    $lastnum=$num;
    (undef, $num, $key, undef) = split / /, $line;
    if (($key eq $lastkey) && (hex($num) > hex($lastnum))) {
	next;      # repeated key
    }
    if ($debug) { print "New key: $key $num\n"; }

    $retstr = handle_key($key);
    if (($debug) || ($retstr !=~ /^250 /)) {
        print $retstr;
    }
}

# never reached - hopefully
close(LSOCK);
close_vdr();
print "Exiting - something happened!\n";
exit;


sub handle_key {
    my $key = $_[0];
    my $rline;

    # You have to define this key in lircd.conf
    if ($key eq "Off") {
	close_vdr();
	return "Closed Connection on Off-key.\n";
    }

    return vdr_cmd("HITK $key\r\n");
}

sub vdr_cmd {
    my $line=$_[0];
    my $rline;

    print VSOCK $line;
    $rline = <VSOCK>;

    # connection closed ?
    if ((!$rline) || ($rline =~ /^221 /)) {
	if ($debug && $rline) { print $rline; }
	close(VSOCK);
	open_vdr();

	print VSOCK $line;
	$rline = <VSOCK>;
    }
    return $rline;
}


sub open_vdr {
    my ($iaddr, $paddr, $proto, $line, $ofh);

    if ($debug) { print "Opening Connection\n"; }

    $iaddr   = inet_aton($vdr_host)   || die "host not found: $vdr_host";
    $paddr   = sockaddr_in($vdr_port, $iaddr);
    $proto   = getprotobyname('tcp');

    socket(VSOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
    connect(VSOCK, $paddr)    || die "$vdr_host:$vdr_port $!";

    # no buffering on socket
    $ofh = select VSOCK;
    $| = 1;
    select $ofh;

    # read intro
    while (defined($line = <VSOCK>)) {
	if ($debug) { print $line; }
	if ( $line =~ /^220 / ) {
	    last;
	}
    }
    return 1;
}

sub close_vdr {
    my $line;
    if ($debug) { print "Closing Connection\n"; }
    print VSOCK "quit\r\n";
    $line = <VSOCK>;
    close(VSOCK);
    return $line;
}


sub parse_args {

    unless ( getopts('h:p:l:t:d') )  {
	print "\nUsage: $0 [-d] [-h <host>] [-p <port>]\n";
	print "\t\t     [-l <lirc-device>] [-t <timeout>]\n\n";
	print @ARGV;
	exit -1;
    }

    if ($opt_d) { $debug=1 }
    if ($opt_h) { $vdr_host = $opt_h }
    if ($opt_p) { $vdr_port = $opt_p }
    if ($opt_l) { $lircd = $opt_d }
    if ($opt_t) { $timeout = $opt_t }
}

---------------------------------





-- 
Juergen Schmidt   Leitender Redakteur/senior editor  c't magazin
Verlag Heinz Heise GmbH & Co KG, Helstorferstr. 7, D-30625 Hannover
EMail: ju@ct.heise.de - Tel.: +49 511 5352 300 - FAX: +49 511 5352 417
PGP-Key available