[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