#!/usr/bin/perl use strict; use warnings; use File::Basename; use File::Temp qw( tempfile ); use IO::Select; use IO::Socket::UNIX; use Device::SerialPort; use Time::HiRes qw( usleep sleep time ); use IPC::System::Simple qw( system capture ); # Local modules use Cwd qw(abs_path); use File::Basename qw(dirname); use lib dirname(abs_path($0)); use DMX; # Prototypes sub sendQuery($$); sub clearBuffer($); sub collectUntil($$); # Device parameters my ($DEV, $PORT, $BLUETOOTH, $BAUD, $DBITS, $SBITS, $PARITY, $CRLF, $DELIMITER, %CMDS, %STATUS_CMDS); if (basename($0) =~ /PROJECTOR/i) { $DEV = 'Projector'; $PORT = '/dev/tty.usbserial-A5006xbj'; $BLUETOOTH = 0; $CRLF = "\r\n"; $DELIMITER = ':'; %CMDS = ( 'INIT' => '', 'ON' => 'PWR ON', 'OFF' => 'PWR OFF', 'STATUS' => 'PWR?', 'DYNAMIC' => 'CMODE 06', 'LIVING_ROOM' => 'CMODE 0C', 'NATURAL' => 'CMODE 07', 'THEATER' => 'CMODE 05', 'THEATER_BLACK_1' => 'CMODE 09', 'THEATER_BLACK_2' => 'CMODE 0A', 'XV' => 'CMODE 0B', 'COLOR' => 'CMODE?', 'HDMI_1' => 'SOURCE 30', 'HDMI_2' => 'SOURCE A0', 'VGA' => 'SOURCE 20', 'INPUT' => 'SOURCE?', 'LAMP' => 'LAMP?', ); %STATUS_CMDS = ( 'STATUS' => { 'MATCH' => [ qr/^PWR=/, qr/PWR=01/ ] }, 'COLOR' => { 'EVAL' => [ qr/^CMODE=[0-9A-Z]{2}$/i, 'if ($a =~ /06$/i) { $a = "DYNAMIC" } elsif ($a =~ /0C$/i) { $a = "LIVING_ROOM" } elsif ($a =~ /07$/i) { $a = "NATURAL" } elsif ($a =~ /05$/i) { $a = "THEATER" } elsif ($a =~ /09$/i) { $a = "THEATER_BLACK_1" } elsif ($a =~ /0A$/i) { $a = "THEATER_BLACK_2" } elsif ($a =~ /0B$/i) { $a = "XV" }' ] }, 'INPUT' => { 'EVAL' => [ qr/^SOURCE=[0-9A-Z]{2}$/i, 'if ($a =~ /30$/i) { $a = "HDMI_1" } elsif ($a =~ /A0$/i) { $a = "HDMI_2" } elsif ($a =~ /20$/i) { $a = "VGA" }' ] }, 'LAMP' => { 'REPLACE' => qr/^LAMP=(\d+)$/i }, ); } elsif (basename($0) =~ /AMPLIFIER/i) { $DEV = 'Amplifier'; $PORT = '/dev/tty.usbserial-AK06MIYD'; $BLUETOOTH = 0; $BAUD = 9600; $CRLF = "\r"; $DELIMITER = "\r"; %CMDS = ( 'INIT' => '', 'ON' => 'PWON', 'OFF' => 'PWSTANDBY', 'STATUS' => 'PW?', 'VOL' => 'MV?', 'VOL+' => 'MVUP', 'VOL-' => 'MVDOWN', 'MUTE' => 'MUON', 'UNMUTE' => 'MUOFF', 'INPUT' => 'SI?', 'PLEX' => 'SITV', 'GAME' => 'SIDVD', 'MODE' => 'MS?', 'SURROUND' => 'MSDOLBY DIGITAL', 'STEREO' => 'MS7CH STEREO', 'INPUT' => 'SI?', 'INPUT_MODE' => 'SD?', 'INPUT_AUTO' => 'SDAUTO', 'INPUT_ANALOG' => 'SDANALOG', 'INPUT_EXT' => 'SDEXT.IN-1', ); %STATUS_CMDS = ( 'STATUS' => { 'MATCH' => [ qr/^PW/, qr/$CMDS{'ON'}/ ] }, 'MODE' => { 'EVAL' => [ qr/^MS/, 'if ($a =~ /STEREO/i) { $a = "STEREO" } elsif ($a =~ /MS(?:DOLBY|DTS)/i) { $a = "SURROUND" }' ] }, 'VOL' => { 'EVAL' => [ qr/^MV/, '$a =~ s/^MV//; if (length($a) > 2) { $a =~ s/(\d\d)(\d)/$1.$2/ }' ] }, 'INPUT' => { 'EVAL' => [ qr/^SI/, 'my $done = 0; foreach my $cmd (keys(%CMDS)) { if ($a eq $CMDS{$cmd}) { $a = $cmd; $done = 1; last; } } if (!$done) { $a =~ s/^SI/UNKNOWN-/; }' ] }, ); } elsif (basename($0) =~ /TV/i) { $DEV = 'TV'; $PORT = '/dev/tty.usbserial-A501JRBK'; $BLUETOOTH = 0; $CRLF = "\r"; $DELIMITER = "\r"; %CMDS = ( 'INIT' => 'RSPW1 ', 'ON' => 'POWR1 ', 'OFF' => 'POWR0 ', 'STATUS' => 'POWR? ', 'MUTE' => 'MUTE1 ', 'UNMUTE' => 'MUTE2 ', 'INPUT' => 'IAVD? ', 'TV' => 'ITVD0 ', 'PLEX' => 'IAVD7 ', 'VOL' => 'VOLM? ', 'CH+' => 'CHUP1 ', 'CH-' => 'CHDW1 ', 'CC' => 'CLCP1 ', 'VOL0' => 'VOLM0 ', 'VOL1' => 'VOLM1 ', 'VOL2' => 'VOLM2 ', 'VOL3' => 'VOLM3 ', 'VOL4' => 'VOLM4 ', 'VOL5' => 'VOLM5 ', 'VOL6' => 'VOLM6 ', 'VOL7' => 'VOLM7 ', 'VOL8' => 'VOLM8 ', 'VOL9' => 'VOLM9 ', 'VOL10' => 'VOLM10 ', 'VOL11' => 'VOLM11 ', 'VOL12' => 'VOLM12 ', 'VOL13' => 'VOLM13 ', 'VOL14' => 'VOLM14 ', 'VOL15' => 'VOLM15 ', 'VOL16' => 'VOLM16 ', 'VOL17' => 'VOLM17 ', 'VOL18' => 'VOLM18 ', 'VOL19' => 'VOLM19 ', 'VOL20' => 'VOLM20 ', 'VOL21' => 'VOLM21 ', 'VOL22' => 'VOLM22 ', 'VOL23' => 'VOLM23 ', 'VOL24' => 'VOLM24 ', 'VOL25' => 'VOLM25 ', 'VOL26' => 'VOLM26 ', 'VOL27' => 'VOLM27 ', 'VOL28' => 'VOLM28 ', 'VOL29' => 'VOLM29 ', 'VOL30' => 'VOLM30 ', 'VOL31' => 'VOLM31 ', 'VOL32' => 'VOLM32 ', 'VOL33' => 'VOLM33 ', 'VOL34' => 'VOLM34 ', 'VOL35' => 'VOLM35 ', 'VOL36' => 'VOLM36 ', 'VOL37' => 'VOLM37 ', 'VOL38' => 'VOLM38 ', 'VOL39' => 'VOLM39 ', 'VOL40' => 'VOLM40 ', 'VOL41' => 'VOLM41 ', 'VOL42' => 'VOLM42 ', 'VOL43' => 'VOLM43 ', 'VOL44' => 'VOLM44 ', 'VOL45' => 'VOLM45 ', 'VOL46' => 'VOLM46 ', 'VOL47' => 'VOLM47 ', 'VOL48' => 'VOLM48 ', 'VOL49' => 'VOLM49 ', 'VOL50' => 'VOLM50 ', 'VOL51' => 'VOLM51 ', 'VOL52' => 'VOLM52 ', 'VOL53' => 'VOLM53 ', 'VOL54' => 'VOLM54 ', 'VOL55' => 'VOLM55 ', 'VOL56' => 'VOLM56 ', 'VOL57' => 'VOLM57 ', 'VOL58' => 'VOLM58 ', 'VOL59' => 'VOLM59 ', 'VOL60' => 'VOLM60 ', ); %STATUS_CMDS = ( 'STATUS' => { 'MATCH' => [ qr/\d/, qr/1/ ] }, 'VOL' => { 'EVAL' => [ qr/\d/, '' ] }, 'INPUT' => { 'EVAL' => [ qr/(\d|ERR)/, 'if ($a =~ /7/i) { $a = "PLEX" } elsif ($a =~ /\d/i) { $a = "OTHER" } else { $a = "TV" }' ] }, ); } elsif (basename($0) =~ /HDMI/i) { $DEV = 'HDMI'; $BLUETOOTH = 0; $BAUD = 19200; $CRLF = "\r"; $DELIMITER = "\r"; %CMDS = ( 'INIT' => '', 'PLEX' => 'sw i01', 'GAME' => 'sw i02', 'IN_3' => 'sw i03', 'IN_4' => 'sw i04', 'IN_NEXT' => 'sw +', 'IN_PREV' => 'sw -', 'POD_ON' => 'pod on', 'POD_OFF' => 'pod off', ); $PORT = `$ENV{'HOME'}/bin/video/serial/findDevice.sh 1d132000`; $PORT =~ s/\s*$//; if (!($PORT =~ /^\/dev\/tty\.usbserial/)) { die("Unable to find serial device by USB location\n"); } %STATUS_CMDS = (); } else { die("No device specified\n"); } # App config my $DATA_DIR = DMX::dataDir(); my $CMD_FILE = uc($DEV); my $BT_CHECK = $ENV{'HOME'} . '/bin/btcheck'; my $BYTE_TIMEOUT = 50; my $SILENCE_TIMEOUT = $BYTE_TIMEOUT * 10; # Debug my $DEBUG = 0; if ($ENV{'DEBUG'}) { $DEBUG = $ENV{'DEBUG'}; print STDERR "Debug enabled\n"; } # Command-line arguments my ($DELAY) = @ARGV; if (!$DELAY) { $DELAY = 1; } # Sanity check if (!-r $PORT) { die('Serial port not available: ' . $PORT . "\n"); } elsif (!-d $DATA_DIR) { die('Data directory not available: ' . $DATA_DIR . "\n"); } # Wait for the serial port to become available if ($BLUETOOTH) { system($BT_CHECK, $DEV); if ($? != 0) { sleep($DELAY); die('Bluetooth device "' . $DEV . "\" not available\n"); } } # Socket init my $select = DMX::selectSock($CMD_FILE); # Port init my $port = new Device::SerialPort($PORT) or die('Unable to open serial connection: ' . $PORT . ": ${!}\n"); if ($BAUD) { $port->baudrate($BAUD); } if ($DBITS) { $port->databits($DBITS); } if ($SBITS) { $port->stopbits($SBITS); } if ($PARITY) { $port->parity($PARITY); } $port->read_const_time($BYTE_TIMEOUT); # Init (clear any previous state) sendQuery($port, $CMDS{'INIT'}); # State my $lastStatus = 0; my %STATUS = (); foreach my $cmd (keys(%STATUS_CMDS)) { my %tmp = ('status' => 0, 'last' => ''); $tmp{'path'} = $DATA_DIR . uc($DEV); if ($cmd ne 'STATUS') { $tmp{'path'} .= '_' . uc($cmd); } if (-r $tmp{'path'}) { unlink($tmp{'path'}); } $STATUS{$cmd} = \%tmp; } # Loop forever while (1) { # Calculate our next timeout # Hold on select() but not more than $DELAY after our last update my $timeout = ($lastStatus + $DELAY) - time(); if ($timeout < 0) { $timeout = 0; } if ($DEBUG > 1) { print STDERR 'Waiting for commands with timeout: ' . $timeout . "\n"; } # Check for queued commands my @ready_clients = $select->can_read($timeout); foreach my $fh (@ready_clients) { # Ensure we won't block on recv() $fh->blocking(0); # Grab the inbound text while (defined($fh->recv(my $text, DMX::maxCmdLen()))) { # Clean the input data $text =~ s/^\s+//; $text =~ s/\s+$//; if ($DEBUG) { print STDERR 'Got command: ' . $text . "\n"; } # Only accept valid commands my $cmd = undef(); foreach my $name (keys(%CMDS)) { if ($name eq $text) { $cmd = $name; last; } } # Send commands to serial device if ($cmd) { if ($DEBUG) { print STDERR 'Sending command: ' . $cmd . "\n"; } my $result = sendQuery($port, $CMDS{$cmd}); if ($DEBUG && $result) { print STDERR "\tGot result: " . $result . "\n"; } } } } # Read periodic data, but not too frequently if (time() > $lastStatus + $DELAY) { # Record the last status update time $lastStatus = time(); foreach my $cmd (keys(%STATUS_CMDS)) { # Save the previous status $STATUS{$cmd}->{'last'} = $STATUS{$cmd}->{'status'}; # Less typing my $scmd = $STATUS_CMDS{$cmd}; # Query if (!defined($CMDS{$cmd})) { die('No such command: ' . $cmd . "\n"); } my $result = sendQuery($port, $CMDS{$cmd}); # On read error wait a short while for the device to recover if (!defined($result) || $result eq '' || !($result =~ /[[:print:]]/)) { print STDERR 'Read error. Delaying ' . (4 * $DELAY) . " seconds\n"; sleep(4 * $DELAY); next; } # Process the (non-empty) result as requested if ($scmd->{'MATCH'}) { if ($result =~ $scmd->{'MATCH'}[0]) { if ($result =~ $scmd->{'MATCH'}[1]) { $STATUS{$cmd}->{'status'} = 1; } else { $STATUS{$cmd}->{'status'} = 0; } } } elsif ($scmd->{'REPLACE'}) { if ($result =~ $scmd->{'REPLACE'}) { $STATUS{$cmd}->{'status'} = $result; $STATUS{$cmd}->{'status'} =~ s/$scmd->{'REPLACE'}/$1/; } } elsif ($scmd->{'EVAL'}) { my $a = $result; if ($result =~ $scmd->{'EVAL'}[0]) { eval($scmd->{'EVAL'}[1]); $STATUS{$cmd}->{'status'} = $a; } } else { die('Invalid status match type "' . (keys(%{$scmd}))[0] . '" in command: ' . $cmd . "\n"); } # Ensure the data is clean $STATUS{$cmd}->{'status'} =~ s/[^\w\.\-]/_/g; # If something has changed, save the state to disk # (if the output file does not exist, something has changed) if ($STATUS{$cmd}->{'status'} ne $STATUS{$cmd}->{'last'} || !-r $STATUS{$cmd}->{'path'}) { if ($DEBUG) { print STDERR 'New ' . uc($DEV) . ' status: ' . $cmd . ' => ' . $STATUS{$cmd}->{'status'} . "\n"; } my ($fh, $tmp) = tempfile($STATUS{$cmd}->{'path'} . '.XXXXXXXX', 'UNLINK' => 0); print $fh $STATUS{$cmd}->{'status'} . "\n"; close($fh); rename($tmp, $STATUS{$cmd}->{'path'}); } } } } # Cleanup undef($select); $port->close(); undef($port); exit(0); sub sendQuery($$) { my ($port, $query) = @_; # Enforce an inter-command delay usleep($SILENCE_TIMEOUT); # Read until the queue is clear (i.e. no data available) # Since we don't have flow control this always causes one read timeout $port->lookclear(); clearBuffer($port); # Send the command my $bytes = $port->write($query . $CRLF); if ($DEBUG) { print STDERR "\tWrote (" . $bytes . '): ' . $query . "\n"; } # Wait for a reply (delimited or timeout) return collectUntil($port, $DELIMITER); } sub clearBuffer($) { my ($port) = @_; my $byte = 1; while (length($byte) > 0) { $byte = $port->read(1); if ($DEBUG && length($byte)) { print STDERR "\tIgnored: " . $byte . "\n"; } } } sub collectUntil($$) { my ($port, $delim) = @_; my $char = substr($delim, 0, 1); # This byte-by-byte reading is not efficient, but it's safe # Allow reading forever as long as we don't exceed the silence timeout my $count = 0; my $string = ''; my $end = undef(); while ($count < $SILENCE_TIMEOUT / $BYTE_TIMEOUT) { my $byte = $port->read(1); if (length($byte)) { $count = 0; $string .= $byte; if ($DEBUG > 1) { print STDERR "\tRead: " . $byte . "\n"; } if (defined($end)) { $end .= $byte; if ($end eq $delim) { last; } elsif ($end ne substr($delim, 0, length($end))) { undef($end); } } elsif ($byte eq $char) { if (length($delim) == 1) { last; } else { $end = $byte; } } } else { $count++; } } # Return undef if there was no data (as opposed to just a delimiter and/or whitespace) if (length($string) < 1) { if ($DEBUG) { print STDERR "Read: \n"; } return undef(); } # Translate CRLF and CR to LF $string =~ s/\r\n/\n/g; $string =~ s/\r/\n/g; # Strip the trailing delimiter $string =~ s/${char}$//; # Strip leading or trailing whitespace $string =~ s/^\s+//; $string =~ s/\s+$//; # Return our clean string if ($DEBUG) { print STDERR 'Read: ' . $string . "\n"; } return $string; }