serial.pl 13 KB

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