[mythtv] Cleaned up DSS script.
Neil Whelchel
koyama at firstlight.net
Tue Mar 2 23:22:27 EST 2004
Hello,
I have an RCA DSS receiver and I was having a few issues with the perl
script intended to control it, so I made a few cleanups.. Here it is in
anyone is interested.
-Neil Whelchel-
First Light Internet Services
760 366-0145
- We don't do Window$, that's what the janitor is for -
Bubble Memory, n.:
A derogatory term, usually referring to a person's
intelligence. See also "vacuum tube".
======================================================================
#!/usr/bin/perl
# dss_control: Remote control of a Sony DSS unit via the serial port
# By Josh Wilmes (http://www.hitchhiker.org/dss)
# Based on info from http://www.isd.net/mevenmo/audiovideo.html
# Modified by Neil Whelchel to support command line and interactive modes.
#
# I take no responsibility for any damage this script might cause.
# Feel free to modify and redistribute this as you see fit, but please retain
# the comments above.
$|=1;
use POSIX qw(:termios_h);
use FileHandle;
$verbose=0;
%pkt_decode=("0xF0" => "START PKT",
"0xF1" => "ERR 1",
"0xF2" => "GOT EXTENDED",
"0xF4" => "END PKT",
"0xF5" => "ERR 2",
"0xFB" => "PROMPT");
%terminal=("0xF1" => -1,
"0xF4" => 1,
"0xF5" => -1);
%cmds=("on" => \&on,
"off" => \&off,
"get_channel" => \&get_channel,
"text" => \&text,
"scroll" => \&scroll,
"hide" => \&hide,
"show" => \&show,
"get_signal" => \&get_signal,
"channel" => \&change_channel,
"key" => \&key,
"verbose" => \&toggle_verbose
);
%keymap=(right => "0x9a",
left => "0x9b",
up => "0x9c",
down => "0x9d",
favorite => "0x9e",
select => "0xc3",
exit => "0xc5",
9 => "0xc6",
8 => "0xc7",
7 => "0xc8",
6 => "0xc9",
5 => "0xca",
4 => "0xcb",
3 => "0xcc",
2 => "0xcd",
1 => "0xce",
0 => "0xcf",
ch_up => "0xd2",
ch_dn => "0xd3",
power => "0xd5",
jump => "0xd8",
guide => "0xe5",
menu => "0xf7");
my $serial=init_serial("/dev/ttyS0","9600");
if(@ARGV){
if ($cmds{$ARGV[0]}) {
$ret=&{$cmds{$ARGV[0]}}($ARGV[1]);
print "$ret\n";
} else {
key($ARGV[0]);
}
exit(0);
}
while(1) {
print "The following commands are available:\n";
foreach (sort keys %cmds) {
if ($_ eq "key") {
print "$_: " . (join ',',sort keys %keymap) . "\n";
} else {
print "$_\n";
}
}
print "\nSelect: ";
$_=<STDIN>;
print "\n";
exit unless defined($_);
($f,$arg)=/(\S+)\s+(.*)/;
if ($cmds{$f}) {
$ret=&{$cmds{$f}}($arg);
print "=> $ret\n\n";
} else {
key($f);
}
}
exit(0);
sub toggle_verbose {
$verbose=! $verbose;
}
sub key {
my ($key)=@_;
if (! $key) {
foreach (sort keys %keymap) { print "$_\n"; }
print "\nSelect: ";
chomp($key=<STDIN>);
print "\n";
}
dss_key($key);
}
sub get_signal {
my ($ret)=dss_command("0x10");
return $ret;
}
sub get_channel {
my @d=dss_command("0x07");
if (scalar(@d) > 1) {
$channel=($d[0] * 256) + $d[1];
} else {
$channel=$d[0];
}
return ($channel);
}
sub off { simple_command("0x01"); }
sub on { simple_command("0x02"); }
sub show { simple_command("0x05"); }
sub hide { simple_command("0x06"); }
sub change_channel {
my ($channel)=@_;
$_=sprintf("%4.4x",$channel);
($n1,$n2)=/(..)(..)/;
simple_command("0x46",$n1,$n2,"0x0");
}
sub text {
($text)=@_;
my $string=substr($text,0,14);
my @a=();
foreach (split //,$string) {
push @a,sprintf ("0x%x",ord($_));
}
simple_command("0x4a",sprintf("0x%x",scalar(@a)), at a);
}
sub scroll {
($text)=@_;
while ($text) {
text($text);
$text=~s/.//;
select(undef,undef,undef,0.25);
}
text();
}
sub dss_key {
my ($key)=@_;
return undef unless $keymap{$key};
simple_command("0x45","0x00","0x00",$keymap{$key});
}
sub simple_command {
if (defined(dss_command(@_))) {
return(1);
} else {
return(undef);
}
}
sub dss_command {
sendbytes("0xFA", at _);
return get_reply();
}
sub sendbytes {
(@send)=@_;
foreach (@send) { s/^0x//g; $_=hex($_); }
print "SEND: " if ($verbose);
foreach $num (@send) {
$str=pack('C',$num);
printf("0x%X [%s] ", $num, $str) if ($verbose);
syswrite($serial,$str,length($str));
}
print "\n" if ($verbose);
}
sub get_reply {
my $starttime=time();
my ($last,$ok, at ret);
print "RECV: " if ($verbose);
while (1) {
$ret=sysread($serial,$buf,1);
$str=sprintf("0x%2.2X", ord($buf));
# busy wait bad!
die ("Error ($str)\n") if (time() - $starttime > 8);
next if $str eq "0x00";
if ($pkt_decode{$str}) {
print $str if ($verbose);
print "[$pkt_decode{$str}] " if ($verbose);
} else {
$_=$str; s/^0x//g; $_=hex($_);
printf("$str(%3.3s) ",$_) if ($verbose);
push (@ret,$_);
}
$ok=1 if ($terminal{$str} > 0);
last if ($terminal{$str});
last if ($last eq "0xFB" && $str eq "0xFB");
$last=$str;
}
print "\n\n" if ($verbose);
return @ret if ($ok);
return undef;
}
sub init_serial {
my($port,$baud)=@_;
my($termios,$cflag,$lflag,$iflag,$oflag);
my($voice);
my $serial=new FileHandle("+>$port") || die "Could not open $port: $!\n";
$termios = POSIX::Termios->new();
$termios->getattr($serial->fileno()) || die "getattr: $!\n";
$cflag= 0 | CS8 | HUPCL | CREAD | CLOCAL;
$lflag= 0;
$iflag= 0 | IGNBRK | IGNPAR | IXON | IXOFF;
$oflag= 0;
$termios->setcflag($cflag);
$termios->setlflag($lflag);
$termios->setiflag($iflag);
$termios->setoflag($oflag);
$termios->setattr($serial->fileno(),TCSANOW) || die "setattr: $!\n";
eval qq[
\$termios->setospeed(POSIX::B$baud) || die "setospeed: \$!\n";
\$termios->setispeed(POSIX::B$baud) || die "setispeed: \$!\n";
];
die $@ if $@;
$termios->setattr($serial->fileno(),TCSANOW) || die "setattr: $!\n";
# This gets rid of all the special characters..
$termios->getattr($serial->fileno()) || die "getattr: $!\n";
for (0..NCCS) {
if ($_ == NCCS) { last; }
# Dont mess up XON/XOFF..
if ($_ == VSTART || $_ == VSTOP) { next; }
$termios->setcc($_,0);
}
$termios->setattr($serial->fileno(),TCSANOW) || die "setattr: $!\n";
return $serial;
}
1;
More information about the mythtv-dev
mailing list