serial.pl 13 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505
  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. $PORT = '/dev/tty.usbserial-AK06MIYD';
  56. $BLUETOOTH = 0;
  57. $BAUD = 9600;
  58. $CRLF = "\r";
  59. $DELIMITER = "\r";
  60. %CMDS = (
  61. 'INIT' => '',
  62. 'ON' => 'PWON',
  63. 'OFF' => 'PWSTANDBY',
  64. 'STATUS' => 'PW?',
  65. 'VOL' => 'MV?',
  66. 'VOL+' => 'MVUP',
  67. 'VOL-' => 'MVDOWN',
  68. 'MUTE' => 'MUON',
  69. 'UNMUTE' => 'MUOFF',
  70. 'INPUT' => 'SI?',
  71. 'PLEX' => 'SITV',
  72. 'GAME' => 'SIDVD',
  73. 'MODE' => 'MS?',
  74. 'SURROUND' => 'MSDOLBY DIGITAL',
  75. 'STEREO' => 'MS7CH STEREO',
  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' => { '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-/; }' ] },
  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. } elsif (basename($0) =~ /HDMI/i) {
  176. $DEV = 'HDMI';
  177. $BLUETOOTH = 0;
  178. $BAUD = 19200;
  179. $CRLF = "\r";
  180. $DELIMITER = "\r";
  181. %CMDS = (
  182. 'INIT' => '',
  183. 'PLEX' => 'sw i01',
  184. 'GAME' => 'sw i02',
  185. 'IN_3' => 'sw i03',
  186. 'IN_4' => 'sw i04',
  187. 'IN_NEXT' => 'sw +',
  188. 'IN_PREV' => 'sw -',
  189. 'POD_ON' => 'pod on',
  190. 'POD_OFF' => 'pod off',
  191. );
  192. $PORT = `$ENV{'HOME'}/bin/video/serial/findDevice.sh 1d132000`;
  193. $PORT =~ s/\s*$//;
  194. if (!($PORT =~ /^\/dev\/tty\.usbserial/)) {
  195. die("Unable to find serial device by USB location\n");
  196. }
  197. %STATUS_CMDS = ();
  198. } else {
  199. die("No device specified\n");
  200. }
  201. # App config
  202. my $DATA_DIR = DMX::dataDir();
  203. my $CMD_FILE = uc($DEV);
  204. my $BT_CHECK = $ENV{'HOME'} . '/bin/btcheck';
  205. my $BYTE_TIMEOUT = 50;
  206. my $SILENCE_TIMEOUT = $BYTE_TIMEOUT * 10;
  207. # Debug
  208. my $DEBUG = 0;
  209. if ($ENV{'DEBUG'}) {
  210. $DEBUG = $ENV{'DEBUG'};
  211. print STDERR "Debug enabled\n";
  212. }
  213. # Command-line arguments
  214. my ($DELAY) = @ARGV;
  215. if (!$DELAY) {
  216. $DELAY = 1;
  217. }
  218. # Sanity check
  219. if (!-r $PORT) {
  220. die('Serial port not available: ' . $PORT . "\n");
  221. } elsif (!-d $DATA_DIR) {
  222. die('Data directory not available: ' . $DATA_DIR . "\n");
  223. }
  224. # Wait for the serial port to become available
  225. if ($BLUETOOTH) {
  226. system($BT_CHECK, $DEV);
  227. if ($? != 0) {
  228. sleep($DELAY);
  229. die('Bluetooth device "' . $DEV . "\" not available\n");
  230. }
  231. }
  232. # Socket init
  233. my $select = DMX::selectSock($CMD_FILE);
  234. # Port init
  235. my $port = new Device::SerialPort($PORT)
  236. or die('Unable to open serial connection: ' . $PORT . ": ${!}\n");
  237. if ($BAUD) {
  238. $port->baudrate($BAUD);
  239. }
  240. if ($DBITS) {
  241. $port->databits($DBITS);
  242. }
  243. if ($SBITS) {
  244. $port->stopbits($SBITS);
  245. }
  246. if ($PARITY) {
  247. $port->parity($PARITY);
  248. }
  249. $port->read_const_time($BYTE_TIMEOUT);
  250. # Init (clear any previous state)
  251. sendQuery($port, $CMDS{'INIT'});
  252. # State
  253. my $lastStatus = 0;
  254. my %STATUS = ();
  255. foreach my $cmd (keys(%STATUS_CMDS)) {
  256. my %tmp = ('status' => 0, 'last' => '');
  257. $tmp{'path'} = $DATA_DIR . uc($DEV);
  258. if ($cmd ne 'STATUS') {
  259. $tmp{'path'} .= '_' . uc($cmd);
  260. }
  261. if (-r $tmp{'path'}) {
  262. unlink($tmp{'path'});
  263. }
  264. $STATUS{$cmd} = \%tmp;
  265. }
  266. # Loop forever
  267. while (1) {
  268. # Calculate our next timeout
  269. # Hold on select() but not more than $DELAY after our last update
  270. my $timeout = ($lastStatus + $DELAY) - time();
  271. if ($timeout < 0) {
  272. $timeout = 0;
  273. }
  274. if ($DEBUG > 1) {
  275. print STDERR 'Waiting for commands with timeout: ' . $timeout . "\n";
  276. }
  277. # Check for queued commands
  278. my @ready_clients = $select->can_read($timeout);
  279. foreach my $fh (@ready_clients) {
  280. # Ensure we won't block on recv()
  281. $fh->blocking(0);
  282. # Grab the inbound text
  283. while (defined($fh->recv(my $text, DMX::maxCmdLen()))) {
  284. # Clean the input data
  285. $text =~ s/^\s+//;
  286. $text =~ s/\s+$//;
  287. if ($DEBUG) {
  288. print STDERR 'Got command: ' . $text . "\n";
  289. }
  290. # Only accept valid commands
  291. my $cmd = undef();
  292. foreach my $name (keys(%CMDS)) {
  293. if ($name eq $text) {
  294. $cmd = $name;
  295. last;
  296. }
  297. }
  298. # Send commands to serial device
  299. if ($cmd) {
  300. if ($DEBUG) {
  301. print STDERR 'Sending command: ' . $cmd . "\n";
  302. }
  303. my $result = sendQuery($port, $CMDS{$cmd});
  304. if ($DEBUG && $result) {
  305. print STDERR "\tGot result: " . $result . "\n";
  306. }
  307. }
  308. }
  309. }
  310. # Read periodic data, but not too frequently
  311. if (time() > $lastStatus + $DELAY) {
  312. # Record the last status update time
  313. $lastStatus = time();
  314. foreach my $cmd (keys(%STATUS_CMDS)) {
  315. # Save the previous status
  316. $STATUS{$cmd}->{'last'} = $STATUS{$cmd}->{'status'};
  317. # Less typing
  318. my $scmd = $STATUS_CMDS{$cmd};
  319. # Query
  320. if (!defined($CMDS{$cmd})) {
  321. die('No such command: ' . $cmd . "\n");
  322. }
  323. my $result = sendQuery($port, $CMDS{$cmd});
  324. # On read error wait a short while for the device to recover
  325. if (!defined($result) || $result eq '' || !($result =~ /[[:print:]]/)) {
  326. print STDERR 'Read error. Delaying ' . (4 * $DELAY) . " seconds\n";
  327. sleep(4 * $DELAY);
  328. next;
  329. }
  330. # Process the (non-empty) result as requested
  331. if ($scmd->{'MATCH'}) {
  332. if ($result =~ $scmd->{'MATCH'}[0]) {
  333. if ($result =~ $scmd->{'MATCH'}[1]) {
  334. $STATUS{$cmd}->{'status'} = 1;
  335. } else {
  336. $STATUS{$cmd}->{'status'} = 0;
  337. }
  338. }
  339. } elsif ($scmd->{'REPLACE'}) {
  340. if ($result =~ $scmd->{'REPLACE'}) {
  341. $STATUS{$cmd}->{'status'} = $result;
  342. $STATUS{$cmd}->{'status'} =~ s/$scmd->{'REPLACE'}/$1/;
  343. }
  344. } elsif ($scmd->{'EVAL'}) {
  345. my $a = $result;
  346. if ($result =~ $scmd->{'EVAL'}[0]) {
  347. eval($scmd->{'EVAL'}[1]);
  348. $STATUS{$cmd}->{'status'} = $a;
  349. }
  350. } else {
  351. die('Invalid status match type "' . (keys(%{$scmd}))[0] . '" in command: ' . $cmd . "\n");
  352. }
  353. # Ensure the data is clean
  354. $STATUS{$cmd}->{'status'} =~ s/[^\w\.\-]/_/g;
  355. # If something has changed, save the state to disk
  356. # (if the output file does not exist, something has changed)
  357. if ($STATUS{$cmd}->{'status'} ne $STATUS{$cmd}->{'last'} || !-r $STATUS{$cmd}->{'path'}) {
  358. if ($DEBUG) {
  359. print STDERR 'New ' . uc($DEV) . ' status: ' . $cmd . ' => ' . $STATUS{$cmd}->{'status'} . "\n";
  360. }
  361. my ($fh, $tmp) = tempfile($STATUS{$cmd}->{'path'} . '.XXXXXXXX', 'UNLINK' => 0);
  362. print $fh $STATUS{$cmd}->{'status'} . "\n";
  363. close($fh);
  364. rename($tmp, $STATUS{$cmd}->{'path'});
  365. }
  366. }
  367. }
  368. }
  369. # Cleanup
  370. undef($select);
  371. $port->close();
  372. undef($port);
  373. exit(0);
  374. sub sendQuery($$) {
  375. my ($port, $query) = @_;
  376. # Enforce an inter-command delay
  377. usleep($SILENCE_TIMEOUT);
  378. # Read until the queue is clear (i.e. no data available)
  379. # Since we don't have flow control this always causes one read timeout
  380. $port->lookclear();
  381. clearBuffer($port);
  382. # Send the command
  383. my $bytes = $port->write($query . $CRLF);
  384. if ($DEBUG) {
  385. print STDERR "\tWrote (" . $bytes . '): ' . $query . "\n";
  386. }
  387. # Wait for a reply (delimited or timeout)
  388. return collectUntil($port, $DELIMITER);
  389. }
  390. sub clearBuffer($) {
  391. my ($port) = @_;
  392. my $byte = 1;
  393. while (length($byte) > 0) {
  394. $byte = $port->read(1);
  395. if ($DEBUG && length($byte)) {
  396. print STDERR "\tIgnored: " . $byte . "\n";
  397. }
  398. }
  399. }
  400. sub collectUntil($$) {
  401. my ($port, $delim) = @_;
  402. my $char = substr($delim, 0, 1);
  403. # This byte-by-byte reading is not efficient, but it's safe
  404. # Allow reading forever as long as we don't exceed the silence timeout
  405. my $count = 0;
  406. my $string = '';
  407. my $end = undef();
  408. while ($count < $SILENCE_TIMEOUT / $BYTE_TIMEOUT) {
  409. my $byte = $port->read(1);
  410. if (length($byte)) {
  411. $count = 0;
  412. $string .= $byte;
  413. if ($DEBUG > 1) {
  414. print STDERR "\tRead: " . $byte . "\n";
  415. }
  416. if (defined($end)) {
  417. $end .= $byte;
  418. if ($end eq $delim) {
  419. last;
  420. } elsif ($end ne substr($delim, 0, length($end))) {
  421. undef($end);
  422. }
  423. } elsif ($byte eq $char) {
  424. if (length($delim) == 1) {
  425. last;
  426. } else {
  427. $end = $byte;
  428. }
  429. }
  430. } else {
  431. $count++;
  432. }
  433. }
  434. # Return undef if there was no data (as opposed to just a delimiter and/or whitespace)
  435. if (length($string) < 1) {
  436. if ($DEBUG) {
  437. print STDERR "Read: <NO DATA>\n";
  438. }
  439. return undef();
  440. }
  441. # Translate CRLF and CR to LF
  442. $string =~ s/\r\n/\n/g;
  443. $string =~ s/\r/\n/g;
  444. # Strip the trailing delimiter
  445. $string =~ s/${char}$//;
  446. # Strip leading or trailing whitespace
  447. $string =~ s/^\s+//;
  448. $string =~ s/\s+$//;
  449. # Return our clean string
  450. if ($DEBUG) {
  451. print STDERR 'Read: ' . $string . "\n";
  452. }
  453. return $string;
  454. }