serial.pl 12 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457
  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. use File::Basename;
  5. use File::Temp qw( tempfile );
  6. use IO::Select;
  7. use IO::Socket::UNIX;
  8. use Device::SerialPort;
  9. use Time::HiRes qw( usleep sleep time );
  10. use IPC::System::Simple qw( system capture );
  11. # Local modules
  12. use Cwd qw(abs_path);
  13. use File::Basename qw(dirname);
  14. use lib dirname(abs_path($0));
  15. use DMX;
  16. # Prototypes
  17. sub sendQuery($$);
  18. sub clearBuffer($);
  19. sub collectUntil($$);
  20. # Device parameters
  21. my ($DEV, $PORT, $BLUETOOTH, $CRLF, $DELIMITER, %CMDS, %STATUS_CMDS);
  22. if (basename($0) =~ /PROJECTOR/i) {
  23. $DEV = 'Projector';
  24. $PORT = '/dev/tty.usbserial-A5006xbj';
  25. $BLUETOOTH = 0;
  26. $CRLF = "\r\n";
  27. $DELIMITER = ':';
  28. %CMDS = (
  29. 'INIT' => '',
  30. 'ON' => 'PWR ON',
  31. 'OFF' => 'PWR OFF',
  32. 'STATUS' => 'PWR?',
  33. 'DYNAMIC' => 'CMODE 06',
  34. 'LIVING_ROOM' => 'CMODE 0C',
  35. 'NATURAL' => 'CMODE 07',
  36. 'THEATER' => 'CMODE 05',
  37. 'THEATER_BLACK_1' => 'CMODE 09',
  38. 'THEATER_BLACK_2' => 'CMODE 0A',
  39. 'XV' => 'CMODE 0B',
  40. 'COLOR' => 'CMODE?',
  41. 'HDMI_1' => 'SOURCE 30',
  42. 'HDMI_2' => 'SOURCE A0',
  43. 'VGA' => 'SOURCE 20',
  44. 'INPUT' => 'SOURCE?',
  45. 'LAMP' => 'LAMP?',
  46. );
  47. %STATUS_CMDS = (
  48. 'STATUS' => { 'MATCH' => [ qr/^PWR=/, qr/PWR=01/ ] },
  49. '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" }' ] },
  50. '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" }' ] },
  51. 'LAMP' => { 'REPLACE' => qr/^LAMP=(\d+)$/i },
  52. );
  53. } elsif (basename($0) =~ /AMPLIFIER/i) {
  54. $DEV = 'Amplifier';
  55. $PORT = '/dev/tty.usbserial-AM01C96Q';
  56. $BLUETOOTH = 0;
  57. $CRLF = "\r";
  58. $DELIMITER = "\r";
  59. %CMDS = (
  60. 'INIT' => '',
  61. 'ON' => 'PWON',
  62. 'OFF' => 'PWSTANDBY',
  63. 'STATUS' => 'PW?',
  64. 'VOL' => 'MV?',
  65. 'VOL+' => 'MVUP',
  66. 'VOL-' => 'MVDOWN',
  67. 'MUTE' => 'MUON',
  68. 'UNMUTE' => 'MUOFF',
  69. 'INPUT' => 'SI?',
  70. 'TV' => 'SITV',
  71. 'DVD' => 'SIDVD',
  72. 'MODE' => 'MS?',
  73. 'SURROUND' => 'MSDOLBY DIGITAL',
  74. 'STEREO' => 'MS7CH STEREO',
  75. 'TV' => 'SITV',
  76. 'INPUT' => 'SI?',
  77. 'INPUT_MODE' => 'SD?',
  78. 'INPUT_AUTO' => 'SDAUTO',
  79. 'INPUT_ANALOG' => 'SDANALOG',
  80. 'INPUT_EXT' => 'SDEXT.IN-1',
  81. );
  82. %STATUS_CMDS = (
  83. 'STATUS' => { 'MATCH' => [ qr/^PW/, qr/$CMDS{'ON'}/ ] },
  84. 'MODE' => { 'EVAL' => [ qr/^MS/, 'if ($a =~ /STEREO/i) { $a = "STEREO" } elsif ($a =~ /MS(?:DOLBY|DTS)/i) { $a = "SURROUND" }' ] },
  85. 'VOL' => { 'EVAL' => [ qr/^MV/, '$a =~ s/^MV//; if (length($a) > 2) { $a =~ s/(\d\d)(\d)/$1.$2/ }' ] },
  86. 'INPUT' => { 'REPLACE' => qr/^SI(.*)/ },
  87. );
  88. } elsif (basename($0) =~ /TV/i) {
  89. $DEV = 'TV';
  90. $PORT = '/dev/tty.usbserial-A501JRBK';
  91. $BLUETOOTH = 0;
  92. $CRLF = "\r";
  93. $DELIMITER = "\r";
  94. %CMDS = (
  95. 'INIT' => 'RSPW1 ',
  96. 'ON' => 'POWR1 ',
  97. 'OFF' => 'POWR0 ',
  98. 'STATUS' => 'POWR? ',
  99. 'MUTE' => 'MUTE1 ',
  100. 'UNMUTE' => 'MUTE2 ',
  101. 'INPUT' => 'IAVD? ',
  102. 'TV' => 'ITVD0 ',
  103. 'PLEX' => 'IAVD7 ',
  104. 'VOL' => 'VOLM? ',
  105. 'CH+' => 'CHUP1 ',
  106. 'CH-' => 'CHDW1 ',
  107. 'CC' => 'CLCP1 ',
  108. 'VOL0' => 'VOLM0 ',
  109. 'VOL1' => 'VOLM1 ',
  110. 'VOL2' => 'VOLM2 ',
  111. 'VOL3' => 'VOLM3 ',
  112. 'VOL4' => 'VOLM4 ',
  113. 'VOL5' => 'VOLM5 ',
  114. 'VOL6' => 'VOLM6 ',
  115. 'VOL7' => 'VOLM7 ',
  116. 'VOL8' => 'VOLM8 ',
  117. 'VOL9' => 'VOLM9 ',
  118. 'VOL10' => 'VOLM10 ',
  119. 'VOL11' => 'VOLM11 ',
  120. 'VOL12' => 'VOLM12 ',
  121. 'VOL13' => 'VOLM13 ',
  122. 'VOL14' => 'VOLM14 ',
  123. 'VOL15' => 'VOLM15 ',
  124. 'VOL16' => 'VOLM16 ',
  125. 'VOL17' => 'VOLM17 ',
  126. 'VOL18' => 'VOLM18 ',
  127. 'VOL19' => 'VOLM19 ',
  128. 'VOL20' => 'VOLM20 ',
  129. 'VOL21' => 'VOLM21 ',
  130. 'VOL22' => 'VOLM22 ',
  131. 'VOL23' => 'VOLM23 ',
  132. 'VOL24' => 'VOLM24 ',
  133. 'VOL25' => 'VOLM25 ',
  134. 'VOL26' => 'VOLM26 ',
  135. 'VOL27' => 'VOLM27 ',
  136. 'VOL28' => 'VOLM28 ',
  137. 'VOL29' => 'VOLM29 ',
  138. 'VOL30' => 'VOLM30 ',
  139. 'VOL31' => 'VOLM31 ',
  140. 'VOL32' => 'VOLM32 ',
  141. 'VOL33' => 'VOLM33 ',
  142. 'VOL34' => 'VOLM34 ',
  143. 'VOL35' => 'VOLM35 ',
  144. 'VOL36' => 'VOLM36 ',
  145. 'VOL37' => 'VOLM37 ',
  146. 'VOL38' => 'VOLM38 ',
  147. 'VOL39' => 'VOLM39 ',
  148. 'VOL40' => 'VOLM40 ',
  149. 'VOL41' => 'VOLM41 ',
  150. 'VOL42' => 'VOLM42 ',
  151. 'VOL43' => 'VOLM43 ',
  152. 'VOL44' => 'VOLM44 ',
  153. 'VOL45' => 'VOLM45 ',
  154. 'VOL46' => 'VOLM46 ',
  155. 'VOL47' => 'VOLM47 ',
  156. 'VOL48' => 'VOLM48 ',
  157. 'VOL49' => 'VOLM49 ',
  158. 'VOL50' => 'VOLM50 ',
  159. 'VOL51' => 'VOLM51 ',
  160. 'VOL52' => 'VOLM52 ',
  161. 'VOL53' => 'VOLM53 ',
  162. 'VOL54' => 'VOLM54 ',
  163. 'VOL55' => 'VOLM55 ',
  164. 'VOL56' => 'VOLM56 ',
  165. 'VOL57' => 'VOLM57 ',
  166. 'VOL58' => 'VOLM58 ',
  167. 'VOL59' => 'VOLM59 ',
  168. 'VOL60' => 'VOLM60 ',
  169. );
  170. %STATUS_CMDS = (
  171. 'STATUS' => { 'MATCH' => [ qr/\d/, qr/1/ ] },
  172. 'VOL' => { 'EVAL' => [ qr/\d/, '' ] },
  173. 'INPUT' => { 'EVAL' => [ qr/(\d|ERR)/, 'if ($a =~ /7/i) { $a = "PLEX" } elsif ($a =~ /\d/i) { $a = "OTHER" } else { $a = "TV" }' ] },
  174. );
  175. } else {
  176. die("No device specified\n");
  177. }
  178. # App config
  179. my $DATA_DIR = DMX::dataDir();
  180. my $CMD_FILE = uc($DEV);
  181. my $BT_CHECK = $ENV{'HOME'} . '/bin/btcheck';
  182. my $BYTE_TIMEOUT = 50;
  183. my $SILENCE_TIMEOUT = $BYTE_TIMEOUT * 10;
  184. # Debug
  185. my $DEBUG = 0;
  186. if ($ENV{'DEBUG'}) {
  187. $DEBUG = $ENV{'DEBUG'};
  188. print STDERR "Debug enabled\n";
  189. }
  190. # Command-line arguments
  191. my ($DELAY) = @ARGV;
  192. if (!$DELAY) {
  193. $DELAY = 1;
  194. }
  195. # Sanity check
  196. if (!-r $PORT) {
  197. die('Serial port not available: ' . $PORT . "\n");
  198. } elsif (!-d $DATA_DIR) {
  199. die('Data directory not available: ' . $DATA_DIR . "\n");
  200. }
  201. # Wait for the serial port to become available
  202. if ($BLUETOOTH) {
  203. system($BT_CHECK, $DEV);
  204. if ($? != 0) {
  205. sleep($DELAY);
  206. die('Bluetooth device "' . $DEV . "\" not available\n");
  207. }
  208. }
  209. # Socket init
  210. my $select = DMX::selectSock($CMD_FILE);
  211. # Port init
  212. my $port = new Device::SerialPort($PORT)
  213. or die('Unable to open serial connection: ' . $PORT . ": ${!}\n");
  214. $port->read_const_time($BYTE_TIMEOUT);
  215. # Init (clear any previous state)
  216. sendQuery($port, $CMDS{'INIT'});
  217. # State
  218. my $lastStatus = 0;
  219. my %STATUS = ();
  220. foreach my $cmd (keys(%STATUS_CMDS)) {
  221. my %tmp = ('status' => 0, 'last' => '');
  222. $tmp{'path'} = $DATA_DIR . uc($DEV);
  223. if ($cmd ne 'STATUS') {
  224. $tmp{'path'} .= '_' . uc($cmd);
  225. }
  226. if (-r $tmp{'path'}) {
  227. unlink($tmp{'path'});
  228. }
  229. $STATUS{$cmd} = \%tmp;
  230. }
  231. # Loop forever
  232. while (1) {
  233. # Calculate our next timeout
  234. # Hold on select() but not more than $DELAY after our last update
  235. my $timeout = ($lastStatus + $DELAY) - time();
  236. if ($timeout < 0) {
  237. $timeout = 0;
  238. }
  239. if ($DEBUG > 1) {
  240. print STDERR 'Waiting for commands with timeout: ' . $timeout . "\n";
  241. }
  242. # Check for queued commands
  243. my @ready_clients = $select->can_read($timeout);
  244. foreach my $fh (@ready_clients) {
  245. # Ensure we won't block on recv()
  246. $fh->blocking(0);
  247. # Grab the inbound text
  248. while (defined($fh->recv(my $text, DMX::maxCmdLen()))) {
  249. # Clean the input data
  250. $text =~ s/^\s+//;
  251. $text =~ s/\s+$//;
  252. if ($DEBUG) {
  253. print STDERR 'Got command: ' . $text . "\n";
  254. }
  255. # Only accept valid commands
  256. my $cmd = undef();
  257. foreach my $name (keys(%CMDS)) {
  258. if ($name eq $text) {
  259. $cmd = $name;
  260. last;
  261. }
  262. }
  263. # Send commands to serial device
  264. if ($cmd) {
  265. if ($DEBUG) {
  266. print STDERR 'Sending command: ' . $cmd . "\n";
  267. }
  268. my $result = sendQuery($port, $CMDS{$cmd});
  269. if ($DEBUG && $result) {
  270. print STDERR "\tGot result: " . $result . "\n";
  271. }
  272. }
  273. }
  274. }
  275. # Read periodic data, but not too frequently
  276. if (time() > $lastStatus + $DELAY) {
  277. # Record the last status update time
  278. $lastStatus = time();
  279. foreach my $cmd (keys(%STATUS_CMDS)) {
  280. # Save the previous status
  281. $STATUS{$cmd}->{'last'} = $STATUS{$cmd}->{'status'};
  282. # Less typing
  283. my $scmd = $STATUS_CMDS{$cmd};
  284. # Query
  285. if (!defined($CMDS{$cmd})) {
  286. die('No such command: ' . $cmd . "\n");
  287. }
  288. my $result = sendQuery($port, $CMDS{$cmd});
  289. # On read error wait a short while for the device to recover
  290. if (!defined($result) || $result eq '' || !($result =~ /[[:print:]]/)) {
  291. print STDERR 'Read error. Delaying ' . (4 * $DELAY) . " seconds\n";
  292. sleep(4 * $DELAY);
  293. next;
  294. }
  295. # Process the (non-empty) result as requested
  296. if ($scmd->{'MATCH'}) {
  297. if ($result =~ $scmd->{'MATCH'}[0]) {
  298. if ($result =~ $scmd->{'MATCH'}[1]) {
  299. $STATUS{$cmd}->{'status'} = 1;
  300. } else {
  301. $STATUS{$cmd}->{'status'} = 0;
  302. }
  303. }
  304. } elsif ($scmd->{'REPLACE'}) {
  305. if ($result =~ $scmd->{'REPLACE'}) {
  306. $STATUS{$cmd}->{'status'} = $result;
  307. $STATUS{$cmd}->{'status'} =~ s/$scmd->{'REPLACE'}/$1/;
  308. }
  309. } elsif ($scmd->{'EVAL'}) {
  310. my $a = $result;
  311. if ($result =~ $scmd->{'EVAL'}[0]) {
  312. eval($scmd->{'EVAL'}[1]);
  313. $STATUS{$cmd}->{'status'} = $a;
  314. }
  315. } else {
  316. die('Invalid status match type "' . (keys(%{$scmd}))[0] . '" in command: ' . $cmd . "\n");
  317. }
  318. # Ensure the data is clean
  319. $STATUS{$cmd}->{'status'} =~ s/[^\w\.\-]/_/g;
  320. # If something has changed, save the state to disk
  321. # (if the output file does not exist, something has changed)
  322. if ($STATUS{$cmd}->{'status'} ne $STATUS{$cmd}->{'last'} || !-r $STATUS{$cmd}->{'path'}) {
  323. if ($DEBUG) {
  324. print STDERR 'New ' . uc($DEV) . ' status: ' . $cmd . ' => ' . $STATUS{$cmd}->{'status'} . "\n";
  325. }
  326. my ($fh, $tmp) = tempfile($STATUS{$cmd}->{'path'} . '.XXXXXXXX', 'UNLINK' => 0);
  327. print $fh $STATUS{$cmd}->{'status'} . "\n";
  328. close($fh);
  329. rename($tmp, $STATUS{$cmd}->{'path'});
  330. }
  331. }
  332. }
  333. }
  334. # Cleanup
  335. undef($select);
  336. $port->close();
  337. undef($port);
  338. exit(0);
  339. sub sendQuery($$) {
  340. my ($port, $query) = @_;
  341. # Enforce an inter-command delay
  342. usleep($SILENCE_TIMEOUT);
  343. # Read until the queue is clear (i.e. no data available)
  344. # Since we don't have flow control this always causes one read timeout
  345. $port->lookclear();
  346. clearBuffer($port);
  347. # Send the command
  348. my $bytes = $port->write($query . $CRLF);
  349. if ($DEBUG) {
  350. print STDERR "\tWrote (" . $bytes . '): ' . $query . "\n";
  351. }
  352. # Wait for a reply (delimited or timeout)
  353. return collectUntil($port, $DELIMITER);
  354. }
  355. sub clearBuffer($) {
  356. my ($port) = @_;
  357. my $byte = 1;
  358. while (length($byte) > 0) {
  359. $byte = $port->read(1);
  360. if ($DEBUG && length($byte)) {
  361. print STDERR "\tIgnored: " . $byte . "\n";
  362. }
  363. }
  364. }
  365. sub collectUntil($$) {
  366. my ($port, $char) = @_;
  367. if (length($char) != 1) {
  368. die('Invalid collection delimiter: ' . $char . "\n");
  369. }
  370. # This byte-by-byte reading is not efficient, but it's safe
  371. # Allow reading forever as long as we don't exceed the silence timeout
  372. my $count = 0;
  373. my $string = '';
  374. while ($count < $SILENCE_TIMEOUT / $BYTE_TIMEOUT) {
  375. my $byte = $port->read(1);
  376. if (length($byte)) {
  377. $count = 0;
  378. $string .= $byte;
  379. if ($DEBUG > 1) {
  380. print STDERR "\tRead: " . $byte . "\n";
  381. }
  382. if ($byte eq $char) {
  383. last;
  384. }
  385. } else {
  386. $count++;
  387. }
  388. }
  389. # Return undef if there was no data (as opposed to just a delimiter and/or whitespace)
  390. if (length($string) < 1) {
  391. if ($DEBUG) {
  392. print STDERR "Read: <NO DATA>\n";
  393. }
  394. return undef();
  395. }
  396. # Translate CRLF and CR to LF
  397. $string =~ s/\r\n/\n/g;
  398. $string =~ s/\r/\n/g;
  399. # Strip the trailing delimiter
  400. $string =~ s/${char}$//;
  401. # Strip leading or trailing whitespace
  402. $string =~ s/^\s+//;
  403. $string =~ s/\s+$//;
  404. # Return our clean string
  405. if ($DEBUG) {
  406. print STDERR 'Read: ' . $string . "\n";
  407. }
  408. return $string;
  409. }